- Timestamp:
- 2014-04-06T17:28:25+02:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r4292 r4616 55 55 PRIVATE 56 56 57 !! * Routine accessibility58 57 PUBLIC cice_sbc_init ! routine called by sbc_init 59 58 PUBLIC cice_sbc_final ! routine called by sbc_final … … 83 82 !! * Substitutions 84 83 # include "domzgr_substitute.h90" 85 84 !!---------------------------------------------------------------------- 86 85 CONTAINS 87 86 … … 225 224 DO jj = 1, jpjm1 226 225 DO ji = 1, jpim1 ! caution: use of Vector Opt. not possible 227 zcoefu = 0.5 * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj))228 zcoefv = 0.5 * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj))226 zcoefu = 0.5 * umask(ji,jj,1) * r1_e1e2u(ji,jj) 227 zcoefv = 0.5 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) 229 228 zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1) 230 sshu_b(ji,jj) = zcoefu * ( e1t(ji ,jj) * e2t(ji ,jj) * sshb(ji ,jj) & 231 & + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) ) 232 sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj ) * e2t(ji,jj ) * sshb(ji,jj ) & 233 & + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) ) 234 sshu_n(ji,jj) = zcoefu * ( e1t(ji ,jj) * e2t(ji ,jj) * sshn(ji ,jj) & 235 & + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) ) 236 sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj ) * e2t(ji,jj ) * sshn(ji,jj ) & 237 & + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) ) 229 sshu_b(ji,jj) = zcoefu * ( e1e2t(ji,jj) * sshb(ji,jj) + e1e2t(ji+1,jj ) * sshb(ji+1,jj ) ) 230 sshv_b(ji,jj) = zcoefv * ( e1e2t(ji,jj) * sshb(ji,jj) + e1e2t(ji ,jj+1) * sshb(ji ,jj+1) ) 231 sshu_n(ji,jj) = zcoefu * ( e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji+1,jj ) * sshn(ji+1,jj ) ) 232 sshv_n(ji,jj) = zcoefv * ( e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji ,jj+1) * sshn(ji ,jj+1) ) 238 233 END DO 239 234 END DO … … 242 237 DO jj = 1, jpjm1 243 238 DO ji = 1, jpim1 ! NO Vector Opt. 244 sshf_n(ji,jj) = 0.5 * umask(ji,jj,1) * umask(ji,jj+1,1) & 245 & / ( e1f(ji,jj ) * e2f(ji,jj ) ) & 246 & * ( e1u(ji,jj ) * e2u(ji,jj ) * sshu_n(ji,jj ) & 247 & + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 248 END DO 239 sshf_n(ji,jj) = 0.5 * umask(ji,jj,1) * umask(ji,jj+1,1) & 240 & * ( e1e2u(ji,jj ) * sshu_n(ji,jj ) & 241 & + e1e2u(ji,jj+1) * sshu_n(ji,jj+1) ) * r1_e1e2f(ji,jj) 242 END DO 249 243 END DO 250 244 CALL lbc_lnk( sshf_n, 'F', 1. ) … … 266 260 INTEGER, INTENT(in ) :: kt ! ocean time step 267 261 INTEGER, INTENT(in ) :: nsbc ! surface forcing type 268 262 ! 269 263 INTEGER :: ji, jj, jl ! dummy loop indices 270 264 REAL(wp), DIMENSION(:,:), POINTER :: ztmp, zpice … … 458 452 ! x comp and y comp of sea surface slope (on F points) 459 453 ! T point to F point 460 DO jj=1,jpjm1 461 DO ji=1,jpim1 462 ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj ))/e1u(ji,jj ) & 463 + (zpice(ji+1,jj+1)-zpice(ji,jj+1))/e1u(ji,jj+1) ) & 464 * fmask(ji,jj,1) 465 ENDDO 466 ENDDO 467 CALL nemo2cice(ztmp,ss_tltx,'F', -1. ) 454 DO jj = 1, jpjm1 455 DO ji = 1, jpim1 456 ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj )) * r1_e1u(ji,jj ) & 457 & + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1) ) * fmask(ji,jj,1) 458 END DO 459 END DO 460 CALL nemo2cice( ztmp,ss_tltx,'F', -1. ) 468 461 469 462 ! T point to F point 470 DO jj=1,jpjm1 471 DO ji=1,jpim1 472 ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj))/e2v(ji ,jj) & 473 + (zpice(ji+1,jj+1)-zpice(ji+1,jj))/e2v(ji+1,jj) ) & 474 * fmask(ji,jj,1) 475 ENDDO 476 ENDDO 463 DO jj = 1, jpjm1 464 DO ji = 1, jpim1 465 ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj)) * r1_e2v(ji ,jj) & 466 & + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj) ) * fmask(ji,jj,1) 467 END DO 468 END DO 477 469 CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) 478 470 … … 532 524 ! [Note that fr_iu hasn't yet been updated, so still from start of CICE timestep] 533 525 534 utau(:,:) =(1.0-fr_iu(:,:))*utau(:,:)-ss_iou(:,:)535 vtau(:,:) =(1.0-fr_iv(:,:))*vtau(:,:)-ss_iov(:,:)526 utau(:,:) = ( 1.0 - fr_iu(:,:) ) * utau(:,:) - ss_iou(:,:) 527 vtau(:,:) = ( 1.0 - fr_iv(:,:) ) * vtau(:,:) - ss_iov(:,:) 536 528 537 529 ! Freshwater fluxes … … 542 534 ! Not ideal since aice won't be the same as in the atmosphere. 543 535 ! Better to use evap and tprecip? (but for now don't read in evap in this case) 544 emp(:,:) = emp(:,:) +fr_i(:,:)*(tprecip(:,:)-sprecip(:,:))536 emp(:,:) = emp(:,:) + fr_i(:,:) * ( tprecip(:,:) - sprecip(:,:) ) 545 537 ELSE IF (nsbc == 4) THEN 546 emp(:,:) = ( 1.0-fr_i(:,:))*emp(:,:)538 emp(:,:) = ( 1.0 - fr_i(:,:) ) * emp(:,:) 547 539 ELSE IF (nsbc ==5) THEN 548 540 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) … … 551 543 ENDIF 552 544 553 CALL cice2nemo( fresh_gbm,ztmp1,'T', 1. )554 CALL cice2nemo( fsalt_gbm,ztmp2,'T', 1. )545 CALL cice2nemo( fresh_gbm, ztmp1,'T', 1. ) 546 CALL cice2nemo( fsalt_gbm, ztmp2,'T', 1. ) 555 547 556 548 ! Check to avoid unphysical expression when ice is forming (ztmp1 negative) … … 559 551 ! This check breaks conservation but seems reasonable until we have prognostic ice salinity 560 552 ! Note the 1000.0 below is to convert from kg salt to g salt (needed for PSU) 561 WHERE (ztmp1(:,:) .lt.0.0) ztmp2(:,:)=MAX(ztmp2(:,:),ztmp1(:,:)*sss_m(:,:)/1000.0)562 sfx(:,:) =ztmp2(:,:)*1000.0563 emp(:,:) =emp(:,:)-ztmp1(:,:)553 WHERE (ztmp1(:,:) < 0._wp ) ztmp2(:,:) = MAX( ztmp2(:,:) , ztmp1(:,:)*sss_m(:,:)/1000._wp ) 554 sfx(:,:) = ztmp2(:,:) * 1000.0 555 emp(:,:) = emp(:,:) - ztmp1(:,:) 564 556 565 557 CALL lbc_lnk( emp , 'T', 1. ) … … 584 576 ! Now add in ice / snow related terms 585 577 ! [fswthru will be zero unless running with calc_Tsfc=T in CICE] 586 CALL cice2nemo( fswthru_gbm,ztmp1,'T', 1. )578 CALL cice2nemo( fswthru_gbm,ztmp1,'T', 1. ) 587 579 qsr(:,:)=qsr(:,:)+ztmp1(:,:) 588 580 CALL lbc_lnk( qsr , 'T', 1. ) … … 590 582 DO jj=1,jpj 591 583 DO ji=1,jpi 592 nfrzmlt(ji,jj) =MAX(nfrzmlt(ji,jj),0.0)584 nfrzmlt(ji,jj) = MAX (nfrzmlt(ji,jj) , 0._wp ) 593 585 ENDDO 594 586 ENDDO … … 818 810 #endif 819 811 !!--------------------------------------------------------------------- 820 821 CHARACTER(len=1), INTENT( in ) :: & 822 cd_type ! nature of pn grid-point 823 ! ! = T or F gridpoints 824 REAL(wp), INTENT( in ) :: & 825 psgn ! control of the sign change 826 ! ! =-1 , the sign is modified following the type of b.c. used 827 ! ! = 1 , no sign change 828 REAL(wp), DIMENSION(jpi,jpj) :: pn 812 CHARACTER(len=1), INTENT( in ) :: cd_type ! nature of pn grid-point (= T or F) 813 REAL(wp) , INTENT( in ) :: psgn ! control of the sign change 814 ! ! =-1 , the sign is modified following the type of b.c. used 815 ! ! = 1 , no sign change 816 REAL(wp), DIMENSION(jpi,jpj) :: pn !!gm INTENT missing !!!!! 829 817 #if !defined key_nemocice_decomp 830 818 REAL(wp), DIMENSION(jpiglo,jpjglo) :: png2 831 819 REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg 832 820 #endif 833 REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc821 REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc !!gm INTENT missing !!!! 834 822 INTEGER (int_kind) :: & 835 823 field_type, &! id for type of field (scalar, vector, angle) … … 838 826 839 827 INTEGER :: ji, jj, jn ! dummy loop indices 828 !!--------------------------------------------------------------------- 840 829 841 830 ! A. Ensure all haloes are filled in NEMO field (pn)
Note: See TracChangeset
for help on using the changeset viewer.
