Changeset 13484 for NEMO/releases/r4.0/r4.0-HEAD/src/OCE
- Timestamp:
- 2020-09-17T14:45:07+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/releases/r4.0/r4.0-HEAD/src/OCE/SBC/sbcflx.F90
r11536 r13484 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 38 37 39 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) 38 40 … … 59 61 !! net downward radiative flux qsr (watt/m2) 60 62 !! net upward freshwater (evapo - precip) emp (kg/m2/s) 63 !! salt flux sfx (pss*dh*rho/dt => g/m2/s) 61 64 !! 62 65 !! CAUTION : - never mask the surface stress fields … … 71 74 !! - emp upward mass flux (evap. - precip.) 72 75 !! - sfx salt flux; set to zero at nit000 but possibly non-zero 73 !! if ice is present76 !! if ice 74 77 !!---------------------------------------------------------------------- 75 78 INTEGER, INTENT(in) :: kt ! ocean time step … … 85 88 CHARACTER(len=100) :: cn_dir ! Root directory for location of flx files 86 89 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 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 89 92 !!--------------------------------------------------------------------- 90 93 ! … … 107 110 slf_i(jp_utau) = sn_utau ; slf_i(jp_vtau) = sn_vtau 108 111 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 110 113 ! 111 114 ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure … … 120 123 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' ) 121 124 ! 122 sfx(:,:) = 0.0_wp ! salt flux due to freezing/melting (non-zero only if ice is present)123 !124 125 ENDIF 125 126 … … 128 129 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! update ocean fluxes at each SBC frequency 129 130 130 IF( ln_dm2dc ) THEN ; qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) ! modify now Qsr to include the diurnal cycle131 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) 132 133 ENDIF 133 134 DO jj = 1, jpj ! set the ocean fluxes from read fields 134 135 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) 139 141 END DO 140 142 END DO 141 143 ! ! 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 143 146 ! 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 ) 146 150 ! 147 ! ! module of wind stress and wind speed at T-point148 zcoef = 1. / ( zrhoa * zcdrag )149 DO jj = 2, jpjm1150 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) = zmod155 wndm(ji,jj) = SQRT( zmod * zcoef )156 END DO157 END DO158 taum(:,:) = taum(:,:) * tmask(:,:,1) ; wndm(:,:) = wndm(:,:) * tmask(:,:,1)159 CALL lbc_lnk( 'sbcflx', taum(:,:), 'T', 1. ) ; CALL lbc_lnk( 'sbcflx', wndm(:,:), 'T', 1. )160 161 151 IF( nitend-nit000 <= 100 .AND. lwp ) THEN ! control print (if less than 100 time-step asked) 162 152 WRITE(numout,*) … … 172 162 ! 173 163 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 ! 174 179 ! 175 180 END SUBROUTINE sbc_flx
Note: See TracChangeset
for help on using the changeset viewer.