Changeset 3355
- Timestamp:
- 2012-04-13T14:05:07+02:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_3352_UKMO8_CICE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r3294 r3355 146 146 !!--------------------------------------------------------------------- 147 147 148 INTEGER :: ji, jj, j pl ! dummy loop indices148 INTEGER :: ji, jj, jl ! dummy loop indices 149 149 150 150 IF( nn_timing == 1 ) CALL timing_start('cice_sbc_init') … … 182 182 CALL cice2nemo(aice,fr_i, 'T', 1. ) 183 183 IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 184 DO j pl=1,ncat185 CALL cice2nemo(aicen(:,:,j pl,:),a_i(:,:,jpl), 'T', 1. )184 DO jl=1,ncat 185 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 186 186 ENDDO 187 187 ENDIF … … 212 212 INTEGER, INTENT(in ) :: nsbc ! surface forcing type 213 213 214 INTEGER :: ji, jj, j pl ! dummy loop indices214 INTEGER :: ji, jj, jl ! dummy loop indices 215 215 REAL(wp), DIMENSION(:,:), POINTER :: ztmp 216 216 REAL(wp), DIMENSION(:,:,:), POINTER :: ztmpn … … 259 259 ! Surface downward latent heat flux (CI_5) 260 260 IF (nsbc == 2) THEN 261 DO j pl=1,ncat262 ztmpn(:,:,j pl)=qla_ice(:,:,1)*a_i(:,:,jpl)261 DO jl=1,ncat 262 ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) 263 263 ENDDO 264 264 ELSE … … 269 269 DO ji=1,jpi 270 270 IF (fr_i(ji,jj).eq.0.0) THEN 271 DO j pl=1,ncat272 ztmpn(ji,jj,j pl)=0.0271 DO jl=1,ncat 272 ztmpn(ji,jj,jl)=0.0 273 273 ENDDO 274 274 ! This will then be conserved in CICE 275 275 ztmpn(ji,jj,1)=qla_ice(ji,jj,1) 276 276 ELSE 277 DO j pl=1,ncat278 ztmpn(ji,jj,j pl)=qla_ice(ji,jj,1)*a_i(ji,jj,jpl)/fr_i(ji,jj)277 DO jl=1,ncat 278 ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj) 279 279 ENDDO 280 280 ENDIF … … 282 282 ENDDO 283 283 ENDIF 284 DO j pl=1,ncat285 CALL nemo2cice(ztmpn(:,:,j pl),flatn_f(:,:,jpl,:),'T', 1. )284 DO jl=1,ncat 285 CALL nemo2cice(ztmpn(:,:,jl),flatn_f(:,:,jl,:),'T', 1. ) 286 286 287 287 ! GBM conductive flux through ice (CI_6) 288 288 ! Convert to GBM 289 289 IF (nsbc == 2) THEN 290 ztmp(:,:) = botmelt(:,:,j pl)*a_i(:,:,jpl)290 ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 291 291 ELSE 292 ztmp(:,:) = botmelt(:,:,j pl)292 ztmp(:,:) = botmelt(:,:,jl) 293 293 ENDIF 294 CALL nemo2cice(ztmp,fcondtopn_f(:,:,j pl,:),'T', 1. )294 CALL nemo2cice(ztmp,fcondtopn_f(:,:,jl,:),'T', 1. ) 295 295 296 296 ! GBM surface heat flux (CI_7) 297 297 ! Convert to GBM 298 298 IF (nsbc == 2) THEN 299 ztmp(:,:) = (topmelt(:,:,j pl)+botmelt(:,:,jpl))*a_i(:,:,jpl)299 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 300 300 ELSE 301 ztmp(:,:) = (topmelt(:,:,j pl)+botmelt(:,:,jpl))301 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl)) 302 302 ENDIF 303 CALL nemo2cice(ztmp,fsurfn_f(:,:,j pl,:),'T', 1. )303 CALL nemo2cice(ztmp,fsurfn_f(:,:,jl,:),'T', 1. ) 304 304 ENDDO 305 305 … … 420 420 INTEGER, INTENT( in ) :: nsbc ! surface forcing type 421 421 422 INTEGER :: ji, jj, j pl ! dummy loop indices423 REAL(wp), DIMENSION(:,:), POINTER :: ztmp 422 INTEGER :: ji, jj, jl ! dummy loop indices 423 REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 424 424 !!--------------------------------------------------------------------- 425 425 426 426 IF( nn_timing == 1 ) CALL timing_start('cice_sbc_out') 427 427 ! 428 CALL wrk_alloc( jpi,jpj, ztmp )428 CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 ) 429 429 430 430 IF( kt == nit000 ) THEN … … 433 433 434 434 ! x comp of ocean-ice stress 435 CALL cice2nemo(strocnx,ztmp ,'F', -1. )435 CALL cice2nemo(strocnx,ztmp1,'F', -1. ) 436 436 ss_iou(:,:)=0.0 437 437 ! F point to U point 438 438 DO jj=2,jpjm1 439 439 DO ji=2,jpim1 440 ss_iou(ji,jj) = 0.5 * ( ztmp (ji,jj-1) + ztmp(ji,jj) ) * umask(ji,jj,1)440 ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1) 441 441 ENDDO 442 442 ENDDO … … 444 444 445 445 ! y comp of ocean-ice stress 446 CALL cice2nemo(strocny,ztmp ,'F', -1. )446 CALL cice2nemo(strocny,ztmp1,'F', -1. ) 447 447 ss_iov(:,:)=0.0 448 448 ! F point to V point … … 450 450 DO jj=1,jpjm1 451 451 DO ji=2,jpim1 452 ss_iov(ji,jj) = 0.5 * ( ztmp (ji-1,jj) + ztmp(ji,jj) ) * vmask(ji,jj,1)452 ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1) 453 453 ENDDO 454 454 ENDDO … … 477 477 ENDIF 478 478 479 ! Subtract fluxes from CICE to get freshwater equivalent flux used in 480 ! salinity calculation 481 CALL cice2nemo(fresh_gbm,ztmp,'T', 1. ) 482 emps(:,:)=emp(:,:)-ztmp(:,:) 483 ! Note the 1000.0 is to convert from kg salt to g salt (needed for PSU) 484 CALL cice2nemo(fsalt_gbm,ztmp,'T', 1. ) 485 DO jj=1,jpj 486 DO ji=1,jpi 487 IF (sss_m(ji,jj).gt.0.0) THEN 488 emps(ji,jj)=emps(ji,jj)+ztmp(ji,jj)*1000.0/sss_m(ji,jj) 489 ENDIF 490 ENDDO 491 ENDDO 492 493 ! No longer remove precip over ice from free surface calculation on basis that the 479 CALL cice2nemo(fresh_gbm,ztmp1,'T', 1. ) 480 CALL cice2nemo(fsalt_gbm,ztmp2,'T', 1. ) 481 ! Check to avoid unphysical expression when ice is forming (ztmp1 negative) 482 ! Otherwise we are effectively allowing ice of higher salinity than the ocean to form 483 ! which has to be compensated for by the ocean salinity potentially going negative 484 ! This check breaks conservation but seems reasonable until we have prognostic ice salinity 485 ! The lines below ensure that when ice is forming emps will not be negative 486 ! Note the 1000.0 below is to convert from kg salt to g salt (needed for PSU) 487 emps(:,:)=0.0 488 WHERE (ztmp1(:,:).lt.0.0) ztmp2(:,:)=MAX(ztmp2(:,:),ztmp1(:,:)*sss_m(:,:)/1000.0) 489 WHERE (sss_m(:,:).gt.0.0) emps(:,:)=-ztmp1(:,:)+ztmp2(:,:)*1000.0/sss_m(:,:) 490 ! Now add other non-ice freshwater contributions into emps 491 emps(:,:)=emp(:,:)+emps(:,:) 492 493 IF (lk_vvl) THEN 494 495 ! The relevant quantity for calculating the salinity change is emps-emp 496 ! This is in fact just the ztmp2*1000.0/sss_m term above 497 emp(:,:)=emp(:,:)-ztmp1(:,:) 498 499 ELSE 500 501 ! Don't remove precip over ice from free surface calculation on basis that the 494 502 ! weight of the precip will affect the free surface even if it falls on the ice 495 ! (same to the argument that freezing / melting of ice doesn't change the free surface) 496 ! Sublimation from the ice is treated in a similar way (included in emp but not emps) 497 ! 498 ! This should not be done in the variable volume case 499 500 IF (.NOT. lk_vvl) THEN 501 503 ! (same argument that freezing / melting of ice doesn't change the free surface) 502 504 emp(:,:) = emp(:,:) - tprecip(:,:)*fr_i(:,:) 503 504 ! Take sublimation into account 505 ! Sublimation from the ice is treated in a similar way (included in emp but not emps) 505 506 IF (nsbc == 5 ) THEN 506 507 emp(:,:) = emp(:,:) + ( emp_ice(:,:) + sprecip(:,:) ) … … 532 533 ! Now add in ice / snow related terms 533 534 ! [fswthru will be zero unless running with calc_Tsfc=T in CICE] 534 CALL cice2nemo(fswthru_gbm,ztmp ,'T', 1. )535 qsr(:,:)=qsr(:,:)+ztmp (:,:)535 CALL cice2nemo(fswthru_gbm,ztmp1,'T', 1. ) 536 qsr(:,:)=qsr(:,:)+ztmp1(:,:) 536 537 CALL lbc_lnk( qsr , 'T', 1. ) 537 538 … … 542 543 ENDDO 543 544 544 CALL cice2nemo(fhocn_gbm,ztmp ,'T', 1. )545 qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp (:,:)545 CALL cice2nemo(fhocn_gbm,ztmp1,'T', 1. ) 546 qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:) 546 547 547 548 CALL lbc_lnk( qns , 'T', 1. ) … … 551 552 CALL cice2nemo(aice,fr_i,'T', 1. ) 552 553 IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 553 DO j pl=1,ncat554 CALL cice2nemo(aicen(:,:,j pl,:),a_i(:,:,jpl), 'T', 1. )554 DO jl=1,ncat 555 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 555 556 ENDDO 556 557 ENDIF … … 570 571 ! Release work space 571 572 572 CALL wrk_dealloc( jpi,jpj, ztmp )573 CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 573 574 ! 574 575 IF( nn_timing == 1 ) CALL timing_stop('cice_sbc_out') … … 587 588 !!--------------------------------------------------------------------- 588 589 589 INTEGER :: j pl ! dummy loop index590 INTEGER :: jl ! dummy loop index 590 591 INTEGER :: ierror 591 592 … … 610 611 ! Snow and ice thicknesses (CO_2 and CO_3) 611 612 612 DO j pl = 1,ncat613 CALL cice2nemo(vsnon(:,:,j pl,:),ht_s(:,:,jpl),'T', 1. )614 CALL cice2nemo(vicen(:,:,j pl,:),ht_i(:,:,jpl),'T', 1. )613 DO jl = 1,ncat 614 CALL cice2nemo(vsnon(:,:,jl,:),ht_s(:,:,jl),'T', 1. ) 615 CALL cice2nemo(vicen(:,:,jl,:),ht_i(:,:,jl),'T', 1. ) 615 616 ENDDO 616 617 !
Note: See TracChangeset
for help on using the changeset viewer.
