Changeset 10425 for NEMO/trunk/src/OCE/SBC/sbcfwb.F90
- Timestamp:
- 2018-12-19T22:54:16+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/SBC/sbcfwb.F90
r10068 r10425 71 71 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztmsk_neg, ztmsk_pos, z_wgt ! 2D workspaces 72 72 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztmsk_tospread, zerp_cor ! - - 73 REAL(wp) ,DIMENSION(1) :: z_fwfprv 74 COMPLEX(wp),DIMENSION(1) :: y_fwfnow 73 75 !!---------------------------------------------------------------------- 74 76 ! … … 86 88 IF( kn_fwb == 3 .AND. ln_isfcav ) CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 with ln_isfcav = .TRUE. not working, we stop ' ) 87 89 ! 88 area = glob_sum( e1e2t(:,:) * tmask(:,:,1)) ! interior global domain surface90 area = glob_sum( 'sbcfwb', e1e2t(:,:) * tmask(:,:,1)) ! interior global domain surface 89 91 ! isf cavities are excluded because it can feedback to the melting with generation of inhibition of plumes 90 92 ! and in case of no melt, it can generate HSSW. … … 102 104 ! 103 105 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 104 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area ! sum over the global domain 105 zcoef = z_fwf * rcp 106 emp(:,:) = emp(:,:) - z_fwf * tmask(:,:,1) 106 y_fwfnow(1) = local_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) 107 CALL mpp_delay_sum( 'sbcfwb', 'fwb', y_fwfnow(:), z_fwfprv(:), kt == nitend - nn_fsbc + 1 ) 108 z_fwfprv(1) = z_fwfprv(1) / area 109 zcoef = z_fwfprv(1) * rcp 110 emp(:,:) = emp(:,:) - z_fwfprv(1) * tmask(:,:,1) 107 111 qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction 108 112 ENDIF … … 127 131 a_fwb_b = a_fwb ! mean sea level taking into account the ice+snow 128 132 ! sum over the global domain 129 a_fwb = glob_sum( e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rau0 ) )133 a_fwb = glob_sum( 'sbcfwb', e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rau0 ) ) 130 134 a_fwb = a_fwb * 1.e+3 / ( area * rday * 365. ) ! convert in Kg/m3/s = mm/s 131 135 !!gm ! !!bug 365d year … … 154 158 WHERE( erp < 0._wp ) ztmsk_pos = 0._wp 155 159 ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:) 156 !157 zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) ) ! Area filled by <0 and >0 erp158 zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) )159 160 ! ! fwf global mean (excluding ocean to ice/snow exchanges) 160 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area161 z_fwf = glob_sum( 'sbcfwb', e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area 161 162 ! 162 163 IF( z_fwf < 0._wp ) THEN ! spread out over >0 erp area to increase evaporation 163 zsurf_tospread = zsurf_pos 164 ztmsk_tospread(:,:) = ztmsk_pos(:,:) 164 zsurf_pos = glob_sum( 'sbcfwb', e1e2t(:,:)*ztmsk_pos(:,:) ) 165 zsurf_tospread = zsurf_pos 166 ztmsk_tospread(:,:) = ztmsk_pos(:,:) 165 167 ELSE ! spread out over <0 erp area to increase precipitation 166 zsurf_tospread = zsurf_neg 167 ztmsk_tospread(:,:) = ztmsk_neg(:,:) 168 zsurf_neg = glob_sum( 'sbcfwb', e1e2t(:,:)*ztmsk_neg(:,:) ) ! Area filled by <0 and >0 erp 169 zsurf_tospread = zsurf_neg 170 ztmsk_tospread(:,:) = ztmsk_neg(:,:) 168 171 ENDIF 169 172 ! 170 zsum_fwf = glob_sum( e1e2t(:,:) * z_fwf ) ! fwf global mean over <0 or >0 erp area173 zsum_fwf = glob_sum( 'sbcfwb', e1e2t(:,:) * z_fwf ) ! fwf global mean over <0 or >0 erp area 171 174 !!gm : zsum_fwf = z_fwf * area ??? it is right? I think so.... 172 175 z_fwf_nsrf = zsum_fwf / ( zsurf_tospread + rsmall ) 173 176 ! ! weight to respect erp field 2D structure 174 zsum_erp = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) )177 zsum_erp = glob_sum( 'sbcfwb', ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) ) 175 178 z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) 176 179 ! ! final correction term to apply … … 178 181 ! 179 182 !!gm ===>>>> lbc_lnk should be useless as all the computation is done over the whole domain ! 180 CALL lbc_lnk( zerp_cor, 'T', 1. )183 CALL lbc_lnk( 'sbcfwb', zerp_cor, 'T', 1. ) 181 184 ! 182 185 emp(:,:) = emp(:,:) + zerp_cor(:,:)
Note: See TracChangeset
for help on using the changeset viewer.