Changeset 13485 for NEMO/trunk/src
- Timestamp:
- 2020-09-17T14:45:30+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/SBC/sbcflx.F90
r13295 r13485 29 29 PUBLIC sbc_flx ! routine called by step.F90 30 30 31 INTEGER , PARAMETER :: jpfld = 5 ! maximum number of files to read32 31 INTEGER , PARAMETER :: jp_utau = 1 ! index of wind stress (i-component) file 33 32 INTEGER , PARAMETER :: jp_vtau = 2 ! index of wind stress (j-component) file … … 35 34 INTEGER , PARAMETER :: jp_qsr = 4 ! index of solar heat file 36 35 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 37 38 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) 38 39 … … 59 60 !! net downward radiative flux qsr (watt/m2) 60 61 !! net upward freshwater (evapo - precip) emp (kg/m2/s) 62 !! salt flux sfx (pss*dh*rho/dt => g/m2/s) 61 63 !! 62 64 !! CAUTION : - never mask the surface stress fields … … 71 73 !! - emp upward mass flux (evap. - precip.) 72 74 !! - sfx salt flux; set to zero at nit000 but possibly non-zero 73 !! if ice is present75 !! if ice 74 76 !!---------------------------------------------------------------------- 75 77 INTEGER, INTENT(in) :: kt ! ocean time step … … 85 87 CHARACTER(len=100) :: cn_dir ! Root directory for location of flx files 86 88 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 read88 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 89 91 !!--------------------------------------------------------------------- 90 92 ! … … 105 107 slf_i(jp_utau) = sn_utau ; slf_i(jp_vtau) = sn_vtau 106 108 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 108 110 ! 109 111 ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure … … 118 120 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' ) 119 121 ! 120 sfx(:,:) = 0.0_wp ! salt flux due to freezing/melting (non-zero only if ice is present)121 !122 122 ENDIF 123 123 … … 126 126 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! update ocean fluxes at each SBC frequency 127 127 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 130 136 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) 136 143 END_2D 137 144 ! ! 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 139 147 ! 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 ) 142 151 ! 143 ! ! module of wind stress and wind speed at T-point144 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) = zmod150 wndm(ji,jj) = SQRT( zmod * zcoef )151 END_2D152 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 155 152 IF( nitend-nit000 <= 100 .AND. lwp ) THEN ! control print (if less than 100 time-step asked) 156 153 WRITE(numout,*) … … 166 163 ! 167 164 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 ) 168 177 ! 169 178 END SUBROUTINE sbc_flx
Note: See TracChangeset
for help on using the changeset viewer.