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 13484 for NEMO/releases – NEMO

Changeset 13484 for NEMO/releases


Ignore:
Timestamp:
2020-09-17T14:45:07+02:00 (4 years ago)
Author:
clem
Message:

4.0-HEAD: fix ticket #2522

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/releases/r4.0/r4.0-HEAD/src/OCE/SBC/sbcflx.F90

    r11536 r13484  
    2929   PUBLIC sbc_flx       ! routine called by step.F90 
    3030 
    31    INTEGER , PARAMETER ::   jpfld   = 5   ! maximum number of files to read  
    3231   INTEGER , PARAMETER ::   jp_utau = 1   ! index of wind stress (i-component) file 
    3332   INTEGER , PARAMETER ::   jp_vtau = 2   ! index of wind stress (j-component) file 
     
    3534   INTEGER , PARAMETER ::   jp_qsr  = 4   ! index of solar heat file 
    3635   INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file 
     36 !!INTEGER , PARAMETER ::   jp_sfx  = 6   ! index of salt flux flux 
     37   INTEGER , PARAMETER ::   jpfld   = 5 !! 6 ! maximum number of files to read  
     38 
    3739   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read) 
    3840 
     
    5961      !!                   net downward radiative flux            qsr   (watt/m2) 
    6062      !!                   net upward freshwater (evapo - precip) emp   (kg/m2/s) 
     63      !!                   salt flux                              sfx   (pss*dh*rho/dt => g/m2/s) 
    6164      !! 
    6265      !!      CAUTION :  - never mask the surface stress fields 
     
    7174      !!              - emp         upward mass flux (evap. - precip.) 
    7275      !!              - sfx         salt flux; set to zero at nit000 but possibly non-zero 
    73       !!                            if ice is present 
     76      !!                            if ice 
    7477      !!---------------------------------------------------------------------- 
    7578      INTEGER, INTENT(in) ::   kt   ! ocean time step 
     
    8588      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files 
    8689      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures 
    87       TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp ! informations about the fields to be read 
    88       NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp 
     90      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp !!, sn_sfx ! informations about the fields to be read 
     91      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp !!, sn_sfx 
    8992      !!--------------------------------------------------------------------- 
    9093      ! 
     
    107110         slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau 
    108111         slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr  
    109          slf_i(jp_emp ) = sn_emp 
     112         slf_i(jp_emp ) = sn_emp !! ;   slf_i(jp_sfx ) = sn_sfx 
    110113         ! 
    111114         ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure 
     
    120123         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' ) 
    121124         ! 
    122          sfx(:,:) = 0.0_wp                         ! salt flux due to freezing/melting (non-zero only if ice is present) 
    123          ! 
    124125      ENDIF 
    125126 
     
    128129      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                        ! update ocean fluxes at each SBC frequency 
    129130 
    130          IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )   ! modify now Qsr to include the diurnal cycle 
    131          ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1) 
     131         IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1)  ! modify now Qsr to include the diurnal cycle 
     132         ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1) 
    132133         ENDIF 
    133134         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields 
    134135            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) 
    137                qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 
    138                emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 
     136               utau(ji,jj) =   sf(jp_utau)%fnow(ji,jj,1)                              * umask(ji,jj,1) 
     137               vtau(ji,jj) =   sf(jp_vtau)%fnow(ji,jj,1)                              * vmask(ji,jj,1) 
     138               qns (ji,jj) = ( sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 
     139               emp (ji,jj) =   sf(jp_emp )%fnow(ji,jj,1)                              * tmask(ji,jj,1) 
     140               !!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1)                              * tmask(ji,jj,1)  
    139141            END DO 
    140142         END DO 
    141143         !                                                        ! add to qns the heat due to e-p 
    142          qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST 
     144         !clem: I do not think it is needed 
     145         !!qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST 
    143146         ! 
    144          qns(:,:) = qns(:,:) * tmask(:,:,1) 
    145          emp(:,:) = emp(:,:) * tmask(:,:,1) 
     147         ! clem: without these lbc calls, it seems that the northfold is not ok (true in 3.6, not sure in 4.x)  
     148         CALL lbc_lnk_multi( 'sbcflx', utau, 'U', -1._wp, vtau, 'V', -1._wp, & 
     149            &                           qns, 'T',  1._wp, emp , 'T',  1._wp, qsr, 'T', 1._wp ) !! sfx, 'T', 1._wp  ) 
    146150         ! 
    147          !                                                        ! module of wind stress and wind speed at T-point 
    148          zcoef = 1. / ( zrhoa * zcdrag ) 
    149          DO jj = 2, jpjm1 
    150             DO ji = fs_2, fs_jpim1   ! vect. opt. 
    151                ztx = utau(ji-1,jj  ) + utau(ji,jj)  
    152                zty = vtau(ji  ,jj-1) + vtau(ji,jj)  
    153                zmod = 0.5 * SQRT( ztx * ztx + zty * zty ) 
    154                taum(ji,jj) = zmod 
    155                wndm(ji,jj) = SQRT( zmod * zcoef ) 
    156             END DO 
    157          END DO 
    158          taum(:,:) = taum(:,:) * tmask(:,:,1) ; wndm(:,:) = wndm(:,:) * tmask(:,:,1) 
    159          CALL lbc_lnk( 'sbcflx', taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( 'sbcflx', wndm(:,:), 'T', 1. ) 
    160  
    161151         IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked) 
    162152            WRITE(numout,*)  
     
    172162         ! 
    173163      ENDIF 
     164      !                                                           ! module of wind stress and wind speed at T-point 
     165      ! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 
     166      zcoef = 1. / ( zrhoa * zcdrag ) 
     167      DO jj = 2, jpjm1 
     168         DO ji = fs_2, fs_jpim1   ! vect. opt. 
     169            ztx = ( utau(ji-1,jj  ) + utau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( umask(ji-1,jj  ,1), umask(ji,jj,1) ) ) 
     170            zty = ( vtau(ji  ,jj-1) + vtau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( vmask(ji  ,jj-1,1), vmask(ji,jj,1) ) )  
     171            zmod = 0.5_wp * SQRT( ztx * ztx + zty * zty ) * tmask(ji,jj,1) 
     172            taum(ji,jj) = zmod 
     173            wndm(ji,jj) = SQRT( zmod * zcoef )  !!clem: not used? 
     174         END DO 
     175      END DO 
     176      ! 
     177      CALL lbc_lnk_multi( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp ) 
     178      ! 
    174179      ! 
    175180   END SUBROUTINE sbc_flx 
Note: See TracChangeset for help on using the changeset viewer.