- Timestamp:
- 2012-11-21T14:19:18+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r3294 r3625 15 15 USE dom_oce ! ocean space and time domain 16 16 USE domvvl 17 USE phycst, only : rcp, rau0 17 USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic 18 18 USE in_out_manager ! I/O manager 19 19 USE lib_mpp ! distributed memory computing library … … 37 37 USE ice_gather_scatter 38 38 USE ice_calendar, only: dt 39 USE ice_state, only: aice,aicen,uvel,vvel,vsno n,vicen39 USE ice_state, only: aice,aicen,uvel,vvel,vsno,vsnon,vice,vicen 40 40 USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow, & 41 41 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_gbm, & … … 59 59 PUBLIC cice_sbc_final ! routine called by sbc_final 60 60 PUBLIC sbc_ice_cice ! routine called by sbc 61 62 INTEGER , PARAMETER :: ji_off = INT ( (jpiglo - nx_global) / 2 ) 63 INTEGER , PARAMETER :: jj_off = INT ( (jpjglo - ny_global) / 2 ) 61 64 62 65 INTEGER , PARAMETER :: jpfld = 13 ! maximum number of files to read … … 107 110 !! ** Action : - time evolution of the CICE sea-ice model 108 111 !! - update all sbc variables below sea-ice: 109 !! utau, vtau, qns , qsr, emp , emps112 !! utau, vtau, qns , qsr, emp , sfx 110 113 !!--------------------------------------------------------------------- 111 114 INTEGER, INTENT(in) :: kt ! ocean time step … … 143 146 !! ** Purpose: Initialise ice related fields for NEMO and coupling 144 147 !! 145 INTEGER, INTENT( in ) :: nsbc ! surface forcing type 146 !!--------------------------------------------------------------------- 147 148 INTEGER :: ji, jj, jpl ! dummy loop indices 148 INTEGER, INTENT( in ) :: nsbc ! surface forcing type 149 REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 150 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar 151 INTEGER :: ji, jj, jl ! dummy loop indices 152 !!--------------------------------------------------------------------- 149 153 150 154 IF( nn_timing == 1 ) CALL timing_start('cice_sbc_init') 155 ! 156 CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 ) 151 157 ! 152 158 IF(lwp) WRITE(numout,*)'cice_sbc_init' … … 182 188 CALL cice2nemo(aice,fr_i, 'T', 1. ) 183 189 IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 184 DO j pl=1,ncat185 CALL cice2nemo(aicen(:,:,j pl,:),a_i(:,:,jpl), 'T', 1. )190 DO jl=1,ncat 191 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 186 192 ENDDO 187 193 ENDIF … … 198 204 CALL lbc_lnk ( fr_iu , 'U', 1. ) 199 205 CALL lbc_lnk ( fr_iv , 'V', 1. ) 206 207 ! ! embedded sea ice 208 IF( nn_ice_embd /= 0 ) THEN ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 209 CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 210 CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 211 snwice_mass (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:) ) 212 snwice_mass_b(:,:) = snwice_mass(:,:) 213 ELSE 214 snwice_mass (:,:) = 0.0_wp ! no mass exchanges 215 snwice_mass_b(:,:) = 0.0_wp ! no mass exchanges 216 ENDIF 217 IF( nn_ice_embd == 2 .AND. & ! full embedment (case 2) & no restart : 218 & .NOT.ln_rstart ) THEN ! deplete the initial ssh belew sea-ice area 219 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 220 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 221 ! 222 ! Note: Changed the initial values of sshb and sshn=> need to recompute ssh[u,v,f]_[b,n] 223 ! which were previously set in domvvl 224 IF ( lk_vvl ) THEN ! Is this necessary? embd 2 should be restricted to vvl only??? 225 DO jj = 1, jpjm1 226 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) ) 229 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) ) 238 END DO 239 END DO 240 CALL lbc_lnk( sshu_b, 'U', 1. ) ; CALL lbc_lnk( sshu_n, 'U', 1. ) 241 CALL lbc_lnk( sshv_b, 'V', 1. ) ; CALL lbc_lnk( sshv_n, 'V', 1. ) 242 DO jj = 1, jpjm1 243 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 249 END DO 250 CALL lbc_lnk( sshf_n, 'F', 1. ) 251 ENDIF 252 ENDIF 253 254 CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 200 255 ! 201 256 IF( nn_timing == 1 ) CALL timing_stop('cice_sbc_init') … … 212 267 INTEGER, INTENT(in ) :: nsbc ! surface forcing type 213 268 214 INTEGER :: ji, jj, j pl ! dummy loop indices215 REAL(wp), DIMENSION(:,:), POINTER :: ztmp 269 INTEGER :: ji, jj, jl ! dummy loop indices 270 REAL(wp), DIMENSION(:,:), POINTER :: ztmp, zpice 216 271 REAL(wp), DIMENSION(:,:,:), POINTER :: ztmpn 272 REAL(wp) :: zintb, zintn ! dummy argument 217 273 !!--------------------------------------------------------------------- 218 274 219 275 IF( nn_timing == 1 ) CALL timing_start('cice_sbc_in') 220 276 ! 221 CALL wrk_alloc( jpi,jpj, ztmp )277 CALL wrk_alloc( jpi,jpj, ztmp, zpice ) 222 278 CALL wrk_alloc( jpi,jpj,ncat, ztmpn ) 223 279 … … 259 315 ! Surface downward latent heat flux (CI_5) 260 316 IF (nsbc == 2) THEN 261 DO j pl=1,ncat262 ztmpn(:,:,j pl)=qla_ice(:,:,1)*a_i(:,:,jpl)317 DO jl=1,ncat 318 ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) 263 319 ENDDO 264 320 ELSE … … 269 325 DO ji=1,jpi 270 326 IF (fr_i(ji,jj).eq.0.0) THEN 271 DO j pl=1,ncat272 ztmpn(ji,jj,j pl)=0.0327 DO jl=1,ncat 328 ztmpn(ji,jj,jl)=0.0 273 329 ENDDO 274 330 ! This will then be conserved in CICE 275 331 ztmpn(ji,jj,1)=qla_ice(ji,jj,1) 276 332 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)333 DO jl=1,ncat 334 ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj) 279 335 ENDDO 280 336 ENDIF … … 282 338 ENDDO 283 339 ENDIF 284 DO j pl=1,ncat285 CALL nemo2cice(ztmpn(:,:,j pl),flatn_f(:,:,jpl,:),'T', 1. )340 DO jl=1,ncat 341 CALL nemo2cice(ztmpn(:,:,jl),flatn_f(:,:,jl,:),'T', 1. ) 286 342 287 343 ! GBM conductive flux through ice (CI_6) 288 344 ! Convert to GBM 289 345 IF (nsbc == 2) THEN 290 ztmp(:,:) = botmelt(:,:,j pl)*a_i(:,:,jpl)346 ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 291 347 ELSE 292 ztmp(:,:) = botmelt(:,:,j pl)348 ztmp(:,:) = botmelt(:,:,jl) 293 349 ENDIF 294 CALL nemo2cice(ztmp,fcondtopn_f(:,:,j pl,:),'T', 1. )350 CALL nemo2cice(ztmp,fcondtopn_f(:,:,jl,:),'T', 1. ) 295 351 296 352 ! GBM surface heat flux (CI_7) 297 353 ! Convert to GBM 298 354 IF (nsbc == 2) THEN 299 ztmp(:,:) = (topmelt(:,:,j pl)+botmelt(:,:,jpl))*a_i(:,:,jpl)355 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 300 356 ELSE 301 ztmp(:,:) = (topmelt(:,:,j pl)+botmelt(:,:,jpl))357 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl)) 302 358 ENDIF 303 CALL nemo2cice(ztmp,fsurfn_f(:,:,j pl,:),'T', 1. )359 CALL nemo2cice(ztmp,fsurfn_f(:,:,jl,:),'T', 1. ) 304 360 ENDDO 305 361 … … 383 439 CALL nemo2cice(ztmp,vocn,'F', -1. ) 384 440 441 IF( nn_ice_embd == 2 ) THEN !== embedded sea ice: compute representative ice top surface ==! 442 ! 443 ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 444 ! = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1} 445 zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp 446 ! 447 ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 448 ! = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 449 zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 450 ! 451 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0 452 ! 453 ! 454 ELSE !== non-embedded sea ice: use ocean surface for slope calculation ==! 455 zpice(:,:) = ssh_m(:,:) 456 ENDIF 457 385 458 ! x comp and y comp of sea surface slope (on F points) 386 459 ! T point to F point 387 460 DO jj=1,jpjm1 388 461 DO ji=1,jpim1 389 ztmp(ji,jj)=0.5 * ( ( ssh_m(ji+1,jj )-ssh_m(ji,jj ))/e1u(ji,jj ) &390 + ( ssh_m(ji+1,jj+1)-ssh_m(ji,jj+1))/e1u(ji,jj+1) ) &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) ) & 391 464 * fmask(ji,jj,1) 392 465 ENDDO … … 397 470 DO jj=1,jpjm1 398 471 DO ji=1,jpim1 399 ztmp(ji,jj)=0.5 * ( ( ssh_m(ji ,jj+1)-ssh_m(ji ,jj))/e2v(ji ,jj) &400 + ( ssh_m(ji+1,jj+1)-ssh_m(ji+1,jj))/e2v(ji+1,jj) ) &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) ) & 401 474 * fmask(ji,jj,1) 402 475 ENDDO … … 420 493 INTEGER, INTENT( in ) :: nsbc ! surface forcing type 421 494 422 INTEGER :: ji, jj, j pl ! dummy loop indices423 REAL(wp), DIMENSION(:,:), POINTER :: ztmp 495 INTEGER :: ji, jj, jl ! dummy loop indices 496 REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 424 497 !!--------------------------------------------------------------------- 425 498 426 499 IF( nn_timing == 1 ) CALL timing_start('cice_sbc_out') 427 500 ! 428 CALL wrk_alloc( jpi,jpj, ztmp )501 CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 ) 429 502 430 503 IF( kt == nit000 ) THEN … … 433 506 434 507 ! x comp of ocean-ice stress 435 CALL cice2nemo(strocnx,ztmp ,'F', -1. )508 CALL cice2nemo(strocnx,ztmp1,'F', -1. ) 436 509 ss_iou(:,:)=0.0 437 510 ! F point to U point 438 511 DO jj=2,jpjm1 439 512 DO ji=2,jpim1 440 ss_iou(ji,jj) = 0.5 * ( ztmp (ji,jj-1) + ztmp(ji,jj) ) * umask(ji,jj,1)513 ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1) 441 514 ENDDO 442 515 ENDDO … … 444 517 445 518 ! y comp of ocean-ice stress 446 CALL cice2nemo(strocny,ztmp ,'F', -1. )519 CALL cice2nemo(strocny,ztmp1,'F', -1. ) 447 520 ss_iov(:,:)=0.0 448 521 ! F point to V point … … 450 523 DO jj=1,jpjm1 451 524 DO ji=2,jpim1 452 ss_iov(ji,jj) = 0.5 * ( ztmp (ji-1,jj) + ztmp(ji,jj) ) * vmask(ji,jj,1)525 ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1) 453 526 ENDDO 454 527 ENDDO … … 473 546 emp(:,:) = (1.0-fr_i(:,:))*emp(:,:) 474 547 ELSE IF (nsbc ==5) THEN 475 ! emp_tot is set in sbc_cpl_ice_flx (call from cice_sbc_in above) 548 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) 549 ! This is currently as required with the coupling fields from the UM atmosphere 476 550 emp(:,:) = emp_tot(:,:)+tprecip(:,:)*fr_i(:,:) 477 551 ENDIF 478 552 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 494 ! 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 502 emp(:,:) = emp(:,:) - tprecip(:,:)*fr_i(:,:) 503 504 ! Take sublimation into account 505 IF (nsbc == 5 ) THEN 506 emp(:,:) = emp(:,:) + ( emp_ice(:,:) + sprecip(:,:) ) 507 ELSE IF (nsbc == 2 ) THEN 508 emp(:,:) = emp(:,:) - qla_ice(:,:,1) / Lsub 509 ENDIF 510 511 ENDIF 512 553 CALL cice2nemo(fresh_gbm,ztmp1,'T', 1. ) 554 CALL cice2nemo(fsalt_gbm,ztmp2,'T', 1. ) 555 556 ! Check to avoid unphysical expression when ice is forming (ztmp1 negative) 557 ! Otherwise we are effectively allowing ice of higher salinity than the ocean to form 558 ! which has to be compensated for by the ocean salinity potentially going negative 559 ! This check breaks conservation but seems reasonable until we have prognostic ice salinity 560 ! 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.0 563 emp(:,:)=emp(:,:)-ztmp1(:,:) 564 513 565 CALL lbc_lnk( emp , 'T', 1. ) 514 CALL lbc_lnk( emps, 'T', 1. )566 CALL lbc_lnk( sfx , 'T', 1. ) 515 567 516 568 ! Solar penetrative radiation and non solar surface heat flux … … 532 584 ! Now add in ice / snow related terms 533 585 ! [fswthru will be zero unless running with calc_Tsfc=T in CICE] 534 CALL cice2nemo(fswthru_gbm,ztmp ,'T', 1. )535 qsr(:,:)=qsr(:,:)+ztmp (:,:)586 CALL cice2nemo(fswthru_gbm,ztmp1,'T', 1. ) 587 qsr(:,:)=qsr(:,:)+ztmp1(:,:) 536 588 CALL lbc_lnk( qsr , 'T', 1. ) 537 589 … … 542 594 ENDDO 543 595 544 CALL cice2nemo(fhocn_gbm,ztmp ,'T', 1. )545 qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp (:,:)596 CALL cice2nemo(fhocn_gbm,ztmp1,'T', 1. ) 597 qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:) 546 598 547 599 CALL lbc_lnk( qns , 'T', 1. ) … … 551 603 CALL cice2nemo(aice,fr_i,'T', 1. ) 552 604 IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 553 DO j pl=1,ncat554 CALL cice2nemo(aicen(:,:,j pl,:),a_i(:,:,jpl), 'T', 1. )605 DO jl=1,ncat 606 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 555 607 ENDDO 556 608 ENDIF … … 568 620 CALL lbc_lnk ( fr_iv , 'V', 1. ) 569 621 622 ! ! embedded sea ice 623 IF( nn_ice_embd /= 0 ) THEN ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 624 CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 625 CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 626 snwice_mass (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:) ) 627 snwice_mass_b(:,:) = snwice_mass(:,:) 628 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt 629 ENDIF 630 570 631 ! Release work space 571 632 572 CALL wrk_dealloc( jpi,jpj, ztmp )633 CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 573 634 ! 574 635 IF( nn_timing == 1 ) CALL timing_stop('cice_sbc_out') … … 587 648 !!--------------------------------------------------------------------- 588 649 589 INTEGER :: j pl ! dummy loop index650 INTEGER :: jl ! dummy loop index 590 651 INTEGER :: ierror 591 652 … … 610 671 ! Snow and ice thicknesses (CO_2 and CO_3) 611 672 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. )673 DO jl = 1,ncat 674 CALL cice2nemo(vsnon(:,:,jl,:),ht_s(:,:,jl),'T', 1. ) 675 CALL cice2nemo(vicen(:,:,jl,:),ht_i(:,:,jl),'T', 1. ) 615 676 ENDDO 616 677 ! … … 780 841 REAL(wp), DIMENSION(jpi,jpj) :: pn 781 842 #if !defined key_nemocice_decomp 843 REAL(wp), DIMENSION(jpiglo,jpjglo) :: png2 782 844 REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg 783 845 #endif … … 798 860 ! Copy local domain data from NEMO to CICE field 799 861 pc(:,:,1)=0.0 800 DO jj=2,ny_block 801 DO ji=2,nx_block 802 pc(ji,jj,1)=pn(ji ,jj-1)862 DO jj=2,ny_block-1 863 DO ji=2,nx_block-1 864 pc(ji,jj,1)=pn(ji-1+ji_off,jj-1+jj_off) 803 865 ENDDO 804 866 ENDDO … … 824 886 ! pcg(:,:)=0.0 825 887 DO jn=1,jpnij 826 DO jj= 1,nlcjt(jn)-1827 DO ji= 2,nlcit(jn)-1828 p cg(ji+nimppt(jn)-2,jj+njmppt(jn)-1)=png(ji,jj,jn)888 DO jj=nldjt(jn),nlejt(jn) 889 DO ji=nldit(jn),nleit(jn) 890 png2(ji+nimppt(jn)-1,jj+njmppt(jn)-1)=png(ji,jj,jn) 829 891 ENDDO 892 ENDDO 893 ENDDO 894 DO jj=1,ny_global 895 DO ji=1,nx_global 896 pcg(ji,jj)=png2(ji+ji_off,jj+jj_off) 830 897 ENDDO 831 898 ENDDO … … 922 989 DO jj=1,jpjm1 923 990 DO ji=1,jpim1 924 pn(ji,jj)=pc(ji ,jj+1,1)991 pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1) 925 992 ENDDO 926 993 ENDDO … … 936 1003 ! Need to make sure this is robust to changes in NEMO halo rows.... 937 1004 ! (may be OK but not spent much time thinking about it) 1005 ! Note that non-existent pcg elements may be used below, but 1006 ! the lbclnk call on pn will replace these with sensible values 938 1007 939 1008 IF (nproc==0) THEN 940 1009 png(:,:,:)=0.0 941 1010 DO jn=1,jpnij 942 DO jj= 1,nlcjt(jn)-1943 DO ji= 2,nlcit(jn)-1944 png(ji,jj,jn)=pcg(ji+nimppt(jn)- 2,jj+njmppt(jn)-1)1011 DO jj=nldjt(jn),nlejt(jn) 1012 DO ji=nldit(jn),nleit(jn) 1013 png(ji,jj,jn)=pcg(ji+nimppt(jn)-1-ji_off,jj+njmppt(jn)-1-jj_off) 945 1014 ENDDO 946 1015 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
