Changeset 13485


Ignore:
Timestamp:
2020-09-17T14:45:30+02:00 (5 months ago)
Author:
clem
Message:

trunk: fix ticket #2522

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/SBC/sbcflx.F90

    r13295 r13485  
    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  
    3738   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read) 
    3839 
     
    5960      !!                   net downward radiative flux            qsr   (watt/m2) 
    6061      !!                   net upward freshwater (evapo - precip) emp   (kg/m2/s) 
     62      !!                   salt flux                              sfx   (pss*dh*rho/dt => g/m2/s) 
    6163      !! 
    6264      !!      CAUTION :  - never mask the surface stress fields 
     
    7173      !!              - emp         upward mass flux (evap. - precip.) 
    7274      !!              - sfx         salt flux; set to zero at nit000 but possibly non-zero 
    73       !!                            if ice is present 
     75      !!                            if ice 
    7476      !!---------------------------------------------------------------------- 
    7577      INTEGER, INTENT(in) ::   kt   ! ocean time step 
     
    8587      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files 
    8688      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 
     89      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp !!, sn_sfx ! informations about the fields to be read 
     90      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp !!, sn_sfx 
    8991      !!--------------------------------------------------------------------- 
    9092      ! 
     
    105107         slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau 
    106108         slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr  
    107          slf_i(jp_emp ) = sn_emp 
     109         slf_i(jp_emp ) = sn_emp !! ;   slf_i(jp_sfx ) = sn_sfx 
    108110         ! 
    109111         ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure 
     
    118120         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' ) 
    119121         ! 
    120          sfx(:,:) = 0.0_wp                         ! salt flux due to freezing/melting (non-zero only if ice is present) 
    121          ! 
    122122      ENDIF 
    123123 
     
    126126      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                        ! update ocean fluxes at each SBC frequency 
    127127 
    128          IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )   ! modify now Qsr to include the diurnal cycle 
    129          ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1) 
     128         IF( ln_dm2dc ) THEN   ! modify now Qsr to include the diurnal cycle 
     129            DO_2D( 0, 0, 0, 0 ) 
     130               qsr(ji,jj) = sbc_dcy( sf(jp_qsr)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 
     131            END_2D 
     132         ELSE 
     133            DO_2D( 0, 0, 0, 0 ) 
     134               qsr(ji,jj) =          sf(jp_qsr)%fnow(ji,jj,1)   * tmask(ji,jj,1) 
     135            END_2D 
    130136         ENDIF 
    131          DO_2D( 1, 1, 1, 1 ) 
    132             utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
    133             vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
    134             qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 
    135             emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 
     137         DO_2D( 0, 0, 0, 0 ) 
     138            utau(ji,jj) =   sf(jp_utau)%fnow(ji,jj,1)                              * umask(ji,jj,1) 
     139            vtau(ji,jj) =   sf(jp_vtau)%fnow(ji,jj,1)                              * vmask(ji,jj,1) 
     140            qns (ji,jj) = ( sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 
     141            emp (ji,jj) =   sf(jp_emp )%fnow(ji,jj,1)                              * tmask(ji,jj,1) 
     142            !!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1)                              * tmask(ji,jj,1)  
    136143         END_2D 
    137144         !                                                        ! add to qns the heat due to e-p 
    138          qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST 
     145         !!clem: I do not think it is needed 
     146         !!qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST 
    139147         ! 
    140          qns(:,:) = qns(:,:) * tmask(:,:,1) 
    141          emp(:,:) = emp(:,:) * tmask(:,:,1) 
     148         ! clem: without these lbc calls, it seems that the northfold is not ok (true in 3.6, not sure in 4.x)  
     149         CALL lbc_lnk_multi( 'sbcflx', utau, 'U', -1._wp, vtau, 'V', -1._wp, & 
     150            &                           qns, 'T',  1._wp, emp , 'T',  1._wp, qsr, 'T', 1._wp ) !! sfx, 'T', 1._wp  ) 
    142151         ! 
    143          !                                                        ! module of wind stress and wind speed at T-point 
    144          zcoef = 1. / ( zrhoa * zcdrag ) 
    145          DO_2D( 0, 0, 0, 0 ) 
    146             ztx = utau(ji-1,jj  ) + utau(ji,jj)  
    147             zty = vtau(ji  ,jj-1) + vtau(ji,jj)  
    148             zmod = 0.5 * SQRT( ztx * ztx + zty * zty ) 
    149             taum(ji,jj) = zmod 
    150             wndm(ji,jj) = SQRT( zmod * zcoef ) 
    151          END_2D 
    152          taum(:,:) = taum(:,:) * tmask(:,:,1) ; wndm(:,:) = wndm(:,:) * tmask(:,:,1) 
    153          CALL lbc_lnk( 'sbcflx', taum(:,:), 'T', 1.0_wp )   ;   CALL lbc_lnk( 'sbcflx', wndm(:,:), 'T', 1.0_wp ) 
    154  
    155152         IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked) 
    156153            WRITE(numout,*)  
     
    166163         ! 
    167164      ENDIF 
     165      !                                                           ! module of wind stress and wind speed at T-point 
     166      ! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 
     167      zcoef = 1. / ( zrhoa * zcdrag ) 
     168      DO_2D( 0, 0, 0, 0 ) 
     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_2D 
     175      ! 
     176      CALL lbc_lnk_multi( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp ) 
    168177      ! 
    169178   END SUBROUTINE sbc_flx 
Note: See TracChangeset for help on using the changeset viewer.