Changeset 10425 for NEMO/trunk/src/OCE/SBC
- Timestamp:
- 2018-12-19T22:54:16+01:00 (5 years ago)
- Location:
- NEMO/trunk/src/OCE/SBC
- Files:
-
- 17 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/SBC/cpl_oasis3.F90
r10404 r10425 456 456 !--- Fill the overlap areas and extra hallows (mpp) 457 457 !--- check periodicity conditions (all cases) 458 IF( .not. llfisrt ) CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 458 IF( .not. llfisrt ) THEN 459 CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 460 ENDIF 459 461 460 462 ENDDO -
NEMO/trunk/src/OCE/SBC/fldread.F90
r10068 r10425 669 669 IF( sdjf%ln_tint ) THEN 670 670 CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fdta(2,2,1,2), sdjf%nrec_a(1) ) 671 CALL lbc_lnk( sdjf%fdta(:,:,1,2),'Z',1. )671 CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,1,2),'Z',1. ) 672 672 ELSE 673 673 CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fnow(2,2,1 ), sdjf%nrec_a(1) ) 674 CALL lbc_lnk( sdjf%fnow(:,:,1 ),'Z',1. )674 CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,1 ),'Z',1. ) 675 675 ENDIF 676 676 ELSE … … 683 683 IF( sdjf%ln_tint ) THEN 684 684 CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(2,2,:,2), sdjf%nrec_a(1) ) 685 CALL lbc_lnk( sdjf%fdta(:,:,:,2),'Z',1. )685 CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,:,2),'Z',1. ) 686 686 ELSE 687 687 CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fnow(2,2,: ), sdjf%nrec_a(1) ) 688 CALL lbc_lnk( sdjf%fnow(:,:,: ),'Z',1. )688 CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,: ),'Z',1. ) 689 689 ENDIF 690 690 ELSE -
NEMO/trunk/src/OCE/SBC/geo2ocean.F90
r10370 r10425 152 152 & gsinv(jpi,jpj), gcosv(jpi,jpj), & 153 153 & gsinf(jpi,jpj), gcosf(jpi,jpj), STAT=ierr ) 154 IF(lk_mpp) CALL mpp_sum(ierr )154 CALL mpp_sum( 'geo2ocean', ierr ) 155 155 IF( ierr /= 0 ) CALL ctl_stop( 'angle: unable to allocate arrays' ) 156 156 ! … … 276 276 ! =========================== ! 277 277 ! ! lateral boundary cond.: T-, U-, V-, F-pts, sgn 278 CALL lbc_lnk_multi( gcost, 'T', -1., gsint, 'T', -1., gcosu, 'U', -1., gsinu, 'U', -1., &278 CALL lbc_lnk_multi( 'geo2ocean', gcost, 'T', -1., gsint, 'T', -1., gcosu, 'U', -1., gsinu, 'U', -1., & 279 279 & gcosv, 'V', -1., gsinv, 'V', -1., gcosf, 'F', -1., gsinf, 'F', -1. ) 280 280 ! … … 304 304 ALLOCATE( gsinlon(jpi,jpj,4) , gcoslon(jpi,jpj,4) , & 305 305 & gsinlat(jpi,jpj,4) , gcoslat(jpi,jpj,4) , STAT=ierr ) 306 IF( lk_mpp ) CALL mpp_sum(ierr )306 CALL mpp_sum( 'geo2ocean', ierr ) 307 307 IF( ierr /= 0 ) CALL ctl_stop('geo2oce: unable to allocate arrays' ) 308 308 ENDIF … … 381 381 ALLOCATE( gsinlon(jpi,jpj,4) , gcoslon(jpi,jpj,4) , & 382 382 & gsinlat(jpi,jpj,4) , gcoslat(jpi,jpj,4) , STAT=ierr ) 383 IF( lk_mpp ) CALL mpp_sum(ierr )383 CALL mpp_sum( 'geo2ocean', ierr ) 384 384 IF( ierr /= 0 ) CALL ctl_stop('oce2geo: unable to allocate arrays' ) 385 385 ENDIF -
NEMO/trunk/src/OCE/SBC/sbc_ice.F90
r10068 r10425 150 150 151 151 sbc_ice_alloc = MAXVAL( ierr ) 152 IF( lk_mpp ) CALL mpp_sum (sbc_ice_alloc )152 CALL mpp_sum ( 'sbc_ice', sbc_ice_alloc ) 153 153 IF( sbc_ice_alloc > 0 ) CALL ctl_warn('sbc_ice_alloc: allocation of arrays failed') 154 154 END FUNCTION sbc_ice_alloc … … 197 197 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(1) ) 198 198 sbc_ice_alloc = MAXVAL( ierr ) 199 IF( lk_mpp ) CALL mpp_sum (sbc_ice_alloc )199 CALL mpp_sum ( 'sbc_ice', sbc_ice_alloc ) 200 200 IF( sbc_ice_alloc > 0 ) CALL ctl_warn('sbc_ice_alloc: allocation of arrays failed') 201 201 END FUNCTION sbc_ice_alloc -
NEMO/trunk/src/OCE/SBC/sbc_oce.F90
r10068 r10425 186 186 ! 187 187 sbc_oce_alloc = MAXVAL( ierr ) 188 IF( lk_mpp ) CALL mpp_sum (sbc_oce_alloc )188 CALL mpp_sum ( 'sbc_oce', sbc_oce_alloc ) 189 189 IF( sbc_oce_alloc > 0 ) CALL ctl_warn('sbc_oce_alloc: allocation of arrays failed') 190 190 ! … … 216 216 END DO 217 217 END DO 218 CALL lbc_lnk( wndm(:,:) , 'T', 1. )218 CALL lbc_lnk( 'sbc_oce', wndm(:,:) , 'T', 1. ) 219 219 ! 220 220 END SUBROUTINE sbc_tau2wnd -
NEMO/trunk/src/OCE/SBC/sbcapr.F90
r10068 r10425 94 94 ! 95 95 IF( ln_ref_apr ) THEN !* Compute whole inner domain mean masked ocean surface 96 tarea = glob_sum( e1e2t(:,:) )96 tarea = glob_sum( 'sbcapr', e1e2t(:,:) ) 97 97 IF(lwp) WRITE(numout,*) ' Variable ref. Patm computed over a ocean surface of ', tarea*1e-6, 'km2' 98 98 ELSE … … 141 141 ! 142 142 ! !* update the reference atmospheric pressure (if necessary) 143 IF( ln_ref_apr ) rn_pref = glob_sum( sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea143 IF( ln_ref_apr ) rn_pref = glob_sum( 'sbcapr', sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea 144 144 ! 145 145 ! !* Patm related forcing at kt -
NEMO/trunk/src/OCE/SBC/sbcblk.F90
r10190 r10425 147 147 & cdn_oce(jpi,jpj), chn_oce(jpi,jpj), cen_oce(jpi,jpj), STAT=sbc_blk_alloc ) 148 148 ! 149 IF( lk_mpp ) CALL mpp_sum (sbc_blk_alloc )150 IF( sbc_blk_alloc /= 0 ) CALL ctl_ warn('sbc_blk_alloc: failed to allocate arrays')149 CALL mpp_sum ( 'sbcblk', sbc_blk_alloc ) 150 IF( sbc_blk_alloc /= 0 ) CALL ctl_stop( 'STOP', 'sbc_blk_alloc: failed to allocate arrays' ) 151 151 END FUNCTION sbc_blk_alloc 152 152 … … 236 236 !Activated wave module but neither drag nor stokes drift activated 237 237 IF ( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) ) THEN 238 CALL ctl_ warn( 'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauwoc=F, ln_stcor=F')238 CALL ctl_stop( 'STOP', 'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauwoc=F, ln_stcor=F' ) 239 239 !drag coefficient read from wave model definable only with mfs bulk formulae and core 240 240 ELSEIF (ln_cdgw .AND. .NOT. ln_NCAR ) THEN … … 407 407 END DO 408 408 END DO 409 CALL lbc_lnk_multi( zwnd_i, 'T', -1., zwnd_j, 'T', -1. )409 CALL lbc_lnk_multi( 'sbcblk', zwnd_i, 'T', -1., zwnd_j, 'T', -1. ) 410 410 ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 411 411 wndm(:,:) = SQRT( zwnd_i(:,:) * zwnd_i(:,:) & … … 485 485 END DO 486 486 END DO 487 CALL lbc_lnk_multi( utau, 'U', -1., vtau, 'V', -1. )487 CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. ) 488 488 489 489 ! Turbulent fluxes over ocean … … 727 727 END DO 728 728 END DO 729 CALL lbc_lnk( wndm_ice, 'T', 1. )729 CALL lbc_lnk( 'sbcblk', wndm_ice, 'T', 1. ) 730 730 ! 731 731 ! Make ice-atm. drag dependent on ice concentration … … 761 761 END DO 762 762 END DO 763 CALL lbc_lnk_multi( utau_ice, 'U', -1., vtau_ice, 'V', -1. )763 CALL lbc_lnk_multi( 'sbcblk', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 764 764 ! 765 765 ! … … 1186 1186 END DO 1187 1187 END DO 1188 CALL lbc_lnk_multi( Cd, 'T', 1., Ch, 'T', 1. )1188 CALL lbc_lnk_multi( 'sbcblk', Cd, 'T', 1., Ch, 'T', 1. ) 1189 1189 ! 1190 1190 END SUBROUTINE Cdn10_Lupkes2015 -
NEMO/trunk/src/OCE/SBC/sbccpl.F90
r10404 r10425 224 224 225 225 sbc_cpl_alloc = MAXVAL( ierr ) 226 IF( lk_mpp ) CALL mpp_sum (sbc_cpl_alloc )226 CALL mpp_sum ( 'sbccpl', sbc_cpl_alloc ) 227 227 IF( sbc_cpl_alloc > 0 ) CALL ctl_warn('sbc_cpl_alloc: allocation of arrays failed') 228 228 ! … … 1162 1162 END DO 1163 1163 END DO 1164 CALL lbc_lnk_multi( frcv(jpr_otx1)%z3(:,:,1), 'U', -1., frcv(jpr_oty1)%z3(:,:,1), 'V', -1. )1164 CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1., frcv(jpr_oty1)%z3(:,:,1), 'V', -1. ) 1165 1165 ENDIF 1166 1166 llnewtx = .TRUE. … … 1189 1189 END DO 1190 1190 END DO 1191 CALL lbc_lnk( frcv(jpr_taum)%z3(:,:,1), 'T', 1. )1191 CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1. ) 1192 1192 llnewtau = .TRUE. 1193 1193 ELSE … … 1570 1570 END SELECT 1571 1571 IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN 1572 CALL lbc_lnk_multi( p_taui, 'U', -1., p_tauj, 'V', -1. )1572 CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. ) 1573 1573 ENDIF 1574 1574 … … 2335 2335 END DO 2336 2336 END DO 2337 CALL lbc_lnk_multi( zitx1, 'T', -1., zity1, 'T', -1. )2337 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. ) 2338 2338 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2339 2339 DO jj = 2, jpjm1 … … 2346 2346 END DO 2347 2347 END SELECT 2348 CALL lbc_lnk_multi( zotx1, ssnd(jps_ocx1)%clgrid, -1., zoty1, ssnd(jps_ocy1)%clgrid, -1. )2348 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1., zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 2349 2349 ! 2350 2350 ENDIF … … 2418 2418 END DO 2419 2419 END DO 2420 CALL lbc_lnk_multi( zitx1, 'T', -1., zity1, 'T', -1. )2420 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. ) 2421 2421 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2422 2422 DO jj = 2, jpjm1 … … 2429 2429 END DO 2430 2430 END SELECT 2431 CALL lbc_lnk_multi( zotx1, ssnd(jps_ocxw)%clgrid, -1., zoty1, ssnd(jps_ocyw)%clgrid, -1. )2431 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1., zoty1, ssnd(jps_ocyw)%clgrid, -1. ) 2432 2432 ! 2433 2433 ! -
NEMO/trunk/src/OCE/SBC/sbcdcy.F90
r10068 r10425 44 44 & rtmd(jpi,jpj) , rdawn(jpi,jpj) , rdusk(jpi,jpj) , rscal(jpi,jpj) , STAT=sbc_dcy_alloc ) 45 45 ! 46 IF( lk_mpp ) CALL mpp_sum (sbc_dcy_alloc )47 IF( sbc_dcy_alloc /= 0 ) CALL ctl_ warn('sbc_dcy_alloc: failed to allocate arrays')46 CALL mpp_sum ( 'sbcdcy', sbc_dcy_alloc ) 47 IF( sbc_dcy_alloc /= 0 ) CALL ctl_stop( 'STOP', 'sbc_dcy_alloc: failed to allocate arrays' ) 48 48 END FUNCTION sbc_dcy_alloc 49 49 -
NEMO/trunk/src/OCE/SBC/sbcflx.F90
r10068 r10425 157 157 END DO 158 158 taum(:,:) = taum(:,:) * tmask(:,:,1) ; wndm(:,:) = wndm(:,:) * tmask(:,:,1) 159 CALL lbc_lnk( taum(:,:), 'T', 1. ) ; CALL lbc_lnk(wndm(:,:), 'T', 1. )159 CALL lbc_lnk( 'sbcflx', taum(:,:), 'T', 1. ) ; CALL lbc_lnk( 'sbcflx', wndm(:,:), 'T', 1. ) 160 160 161 161 IF( nitend-nit000 <= 100 .AND. lwp ) THEN ! control print (if less than 100 time-step asked) -
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(:,:) -
NEMO/trunk/src/OCE/SBC/sbcice_cice.F90
r10068 r10425 100 100 !!---------------------------------------------------------------------- 101 101 ALLOCATE( png(jpi,jpj,jpnij), STAT=sbc_ice_cice_alloc ) 102 IF( lk_mpp ) CALL mpp_sum (sbc_ice_cice_alloc )102 CALL mpp_sum ( 'sbcice_cice', sbc_ice_cice_alloc ) 103 103 IF( sbc_ice_cice_alloc > 0 ) CALL ctl_warn('sbc_ice_cice_alloc: allocation of arrays failed.') 104 104 END FUNCTION sbc_ice_cice_alloc … … 217 217 ENDDO 218 218 219 CALL lbc_lnk_multi( fr_iu , 'U', 1., fr_iv , 'V', 1. )219 CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1., fr_iv , 'V', 1. ) 220 220 221 221 ! set the snow+ice mass … … 513 513 ENDDO 514 514 ENDDO 515 CALL lbc_lnk( ss_iou , 'U', -1. )515 CALL lbc_lnk( 'sbcice_cice', ss_iou , 'U', -1. ) 516 516 517 517 ! y comp of ocean-ice stress … … 525 525 ENDDO 526 526 ENDDO 527 CALL lbc_lnk( ss_iov , 'V', -1. )527 CALL lbc_lnk( 'sbcice_cice', ss_iov , 'V', -1. ) 528 528 529 529 ! x and y comps of surface stress … … 578 578 fmmflx(:,:) = ztmp1(:,:) !!Joakim edit 579 579 580 CALL lbc_lnk_multi( emp , 'T', 1., sfx , 'T', 1. )580 CALL lbc_lnk_multi( 'sbcice_cice', emp , 'T', 1., sfx , 'T', 1. ) 581 581 582 582 ! Solar penetrative radiation and non solar surface heat flux … … 604 604 #endif 605 605 qsr(:,:)=qsr(:,:)+ztmp1(:,:) 606 CALL lbc_lnk( qsr , 'T', 1. )606 CALL lbc_lnk( 'sbcice_cice', qsr , 'T', 1. ) 607 607 608 608 DO jj=1,jpj … … 619 619 qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:) 620 620 621 CALL lbc_lnk( qns , 'T', 1. )621 CALL lbc_lnk( 'sbcice_cice', qns , 'T', 1. ) 622 622 623 623 ! Prepare for the following CICE time-step … … 639 639 ENDDO 640 640 641 CALL lbc_lnk_multi( fr_iu , 'U', 1., fr_iv , 'V', 1. )641 CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1., fr_iv , 'V', 1. ) 642 642 643 643 ! set the snow+ice mass … … 863 863 ! A. Ensure all haloes are filled in NEMO field (pn) 864 864 865 CALL lbc_lnk( pn , cd_type, psgn )865 CALL lbc_lnk( 'sbcice_cice', pn , cd_type, psgn ) 866 866 867 867 #if defined key_nemocice_decomp … … 1040 1040 ! D. Ensure all haloes are filled in pn 1041 1041 1042 CALL lbc_lnk( pn , cd_type, psgn )1042 CALL lbc_lnk( 'sbcice_cice', pn , cd_type, psgn ) 1043 1043 1044 1044 END SUBROUTINE cice2nemo -
NEMO/trunk/src/OCE/SBC/sbcisf.F90
r10068 r10425 157 157 158 158 ! lbclnk 159 CALL lbc_lnk_multi( risf_tsc(:,:,jp_tem), 'T', 1., risf_tsc(:,:,jp_sal), 'T', 1., fwfisf,'T', 1., qisf, 'T', 1.)159 CALL lbc_lnk_multi( 'sbcisf', risf_tsc(:,:,jp_tem), 'T', 1., risf_tsc(:,:,jp_sal), 'T', 1., fwfisf,'T', 1., qisf, 'T', 1.) 160 160 ! output 161 161 IF( iom_use('iceshelf_cea') ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) ) ! isf mass flux … … 244 244 & STAT= sbc_isf_alloc ) 245 245 ! 246 IF( lk_mpp ) CALL mpp_sum (sbc_isf_alloc )247 IF( sbc_isf_alloc /= 0 ) CALL ctl_ warn('sbc_isf_alloc: failed to allocate arrays.')246 CALL mpp_sum ( 'sbcisf', sbc_isf_alloc ) 247 IF( sbc_isf_alloc /= 0 ) CALL ctl_stop( 'STOP', 'sbc_isf_alloc: failed to allocate arrays.' ) 248 248 ! 249 249 ENDIF … … 721 721 END DO 722 722 END DO 723 CALL lbc_lnk_multi( pgt, 'T', 1., pgs, 'T', 1.)723 CALL lbc_lnk_multi( 'sbcisf', pgt, 'T', 1., pgs, 'T', 1.) 724 724 END SELECT 725 725 ! … … 778 778 END DO 779 779 END DO 780 CALL lbc_lnk( pvarout,'T',-1.)780 CALL lbc_lnk('sbcisf', pvarout,'T',-1.) 781 781 782 782 CASE ( 'V' ) ! compute V in the top boundary layer at T- point … … 810 810 END DO 811 811 END DO 812 CALL lbc_lnk( pvarout,'T',-1.)812 CALL lbc_lnk('sbcisf', pvarout,'T',-1.) 813 813 814 814 CASE ( 'T' ) ! compute T in the top boundary layer at T- point -
NEMO/trunk/src/OCE/SBC/sbcmod.F90
r10190 r10425 115 115 IF(lwm) WRITE( numond, namsbc ) 116 116 ! 117 #if defined key_mpp_mpi 118 ncom_fsbc = nn_fsbc ! make nn_fsbc available for lib_mpp 119 #endif 117 120 ! !* overwrite namelist parameter using CPP key information 118 121 #if defined key_agrif … … 440 443 ! icebergs may advect into haloes during the icb step and alter emp. 441 444 ! A lbc_lnk is necessary here to ensure restartability (#2113) 442 IF( .NOT. ln_passive_mode ) CALL lbc_lnk( emp, 'T', 1. ) ! ensure restartability with icebergs445 IF( .NOT. ln_passive_mode ) CALL lbc_lnk( 'sbcmod', emp, 'T', 1. ) ! ensure restartability with icebergs 443 446 ENDIF 444 447 … … 457 460 !!$!RBbug do not understand why see ticket 667 458 461 !!$!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why. 459 !!$ CALL lbc_lnk( emp, 'T', 1. )462 !!$ CALL lbc_lnk( 'sbcmod', emp, 'T', 1. ) 460 463 ! 461 464 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! -
NEMO/trunk/src/OCE/SBC/sbcrnf.F90
r10068 r10425 83 83 & rnf_tsc_b(jpi,jpj,jpts) , rnf_tsc (jpi,jpj,jpts) , STAT=sbc_rnf_alloc ) 84 84 ! 85 IF( lk_mpp ) CALL mpp_sum (sbc_rnf_alloc )85 CALL mpp_sum ( 'sbcrnf', sbc_rnf_alloc ) 86 86 IF( sbc_rnf_alloc > 0 ) CALL ctl_warn('sbc_rnf_alloc: allocation of arrays failed') 87 87 END FUNCTION sbc_rnf_alloc … … 423 423 IF( nn_rnf_depth_file == 1 ) THEN ! save output nb levels for runoff 424 424 IF(lwp) WRITE(numout,*) ' ==>>> create runoff depht file' 425 CALL iom_open ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE. , kiolib = jprstlib)425 CALL iom_open ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE. ) 426 426 CALL iom_rstput( 0, 0, inum, 'rodepth', h_rnf ) 427 427 CALL iom_close ( inum ) -
NEMO/trunk/src/OCE/SBC/sbcssm.F90
r10068 r10425 18 18 USE sbcapr ! surface boundary condition: atmospheric pressure 19 19 USE eosbn2 ! equation of state and related derivatives 20 USE traqsr, ONLY: ln_traqsr 20 21 ! 21 22 USE in_out_manager ! I/O manager … … 253 254 ENDIF 254 255 ! 256 IF( .NOT. ln_traqsr ) fraqsr_1lev(:,:) = 1._wp ! default definition: qsr 100% in the fisrt level 257 ! 255 258 IF( lwxios.AND.nn_fsbc > 1 ) THEN 256 259 CALL iom_set_rstw_var_active('nn_fsbc') -
NEMO/trunk/src/OCE/SBC/sbcwave.F90
r10068 r10425 215 215 ENDIF 216 216 217 CALL lbc_lnk_multi( usd, 'U', -1., vsd, 'V', -1. )217 CALL lbc_lnk_multi( 'sbcwave', usd, 'U', -1., vsd, 'V', -1. ) 218 218 219 219 ! … … 240 240 #endif 241 241 ! 242 CALL lbc_lnk( ze3divh, 'T', 1. )242 CALL lbc_lnk( 'sbcwave', ze3divh, 'T', 1. ) 243 243 ! 244 244 IF( ln_linssh ) THEN ; ik = 1 ! none zero velocity through the sea surface … … 301 301 END DO 302 302 END DO 303 CALL lbc_lnk_multi( utau(:,:), 'U', -1. , vtau(:,:), 'V', -1. , taum(:,:) , 'T', -1. )303 CALL lbc_lnk_multi( 'sbcwave', utau(:,:), 'U', -1. , vtau(:,:), 'V', -1. , taum(:,:) , 'T', -1. ) 304 304 ENDIF 305 305 !
Note: See TracChangeset
for help on using the changeset viewer.