Changeset 1166 for branches/dev_003_CPL/NEMO/OPA_SRC/SBC/sbccpl.F90
- Timestamp:
- 2008-07-30T16:54:02+02:00 (16 years ago)
- File:
-
- 1 edited
-
branches/dev_003_CPL/NEMO/OPA_SRC/SBC/sbccpl.F90 (modified) (22 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_003_CPL/NEMO/OPA_SRC/SBC/sbccpl.F90
r1165 r1166 30 30 USE lib_mpp ! distribued memory computing library 31 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 32 USE oce, ONLY : tn, un, vn 33 USE phycst, ONLY : rt0 34 USE albedo 32 35 33 36 IMPLICIT NONE … … 53 56 INTEGER :: jpsnd_albice, jpsnd_albmix ! Index used for albedo 54 57 INTEGER :: jpsnd_tckice, jpsnd_tcksnw ! Index used for thickness 55 INTEGER :: jpsnd_uoce, jpsnd_voce, jpsnd_uice, jpsnd_vice, jpsnd_umix, jpsnd_vmix ! Index used for current velocity 58 INTEGER :: jpsnd_ocx1, jpsnd_ocy1, jpsnd_ocz1, jpsnd_ocx2, jpsnd_ocy2, jpsnd_ocz2 ! Index used for current velocity 59 INTEGER :: jpsnd_ivx1, jpsnd_ivy1, jpsnd_ivz1, jpsnd_ivx2, jpsnd_ivy2, jpsnd_ivz2 ! Index used for ice velocity 60 INTEGER, DIMENSION(jpi,jpj) :: mskneg, mskpos 61 ! Masks uses for negative runoff suppression 56 62 57 63 CHARACTER(len=100) :: cn_snd_temperature, cn_snd_albedo, cn_snd_thickness, & ! Description of coupled mode … … 59 65 cn_rcv_w10m, cn_rcv_stress_1, cn_rcv_stress_2, cn_rcv_stress_3, & 60 66 cn_rcv_stress_4,cn_rcv_dqnsdt, cn_rcv_qsr, cn_rcv_qns, cn_rcv_emp, & 61 cn_rcv_rnf, cn_rcv_cal 67 cn_rcv_cal 68 69 CHARACTER(len=100), PUBLIC :: cn_rcv_rnf 62 70 63 71 CHARACTER(len=100), DIMENSION(4) :: cn_snd_current, cn_rcv_stress 72 73 REAL(wp) :: zcumulneg, zcumulpos 74 ! Temporary buffer for runoff averages 75 REAL(wp), DIMENSION(jpi,jpj) :: cpl_ocean_albedo, albedo_oce_cs, albedo_oce_ov ! Values for ocean albedo sent to atmosphere 64 76 65 77 !!---------------------------------------------------------------------- … … 111 123 !!$ Probleme: definir comment on initialise freeze, alb_ice et tn_ice 112 124 !!$ quand on n'a pas de restart (a nit000) 125 !! >> Eric: pour le premier pas de temps du premier jour de la simulation 126 !! >> je prefere faire un truc vraiment crade 127 !! >> vu que c est vraiment la premiere et derniere occasion 113 128 114 129 !!! >> Arnaud pour lire freeze, alb_ice et tn_ice dans le restart oasis … … 116 131 ! CALL iom_get( numror, jpdom_local_full, 'freeze' , freeze ) 117 132 118 ierr = nf90_OPEN('sstoc.nc',NF90_NOWRITE,ncid)119 120 ierr = NF90_INQ_VARID(ncid,'OIceFrac',varid)121 ierr = NF90_GET_VAR(ncid,varid,freeze)122 123 ierr = NF90_INQ_VARID(ncid,'O_AlbIce',varid)124 ierr = NF90_GET_VAR(ncid,varid,alb_ice)125 126 ierr = NF90_INQ_VARID(ncid,'O_TepIce',varid)127 ierr = NF90_GET_VAR(ncid,varid,tn_ice)128 129 ierr = NF90_close(ncid)133 !!! ierr = nf90_OPEN('sstoc.nc',NF90_NOWRITE,ncid) 134 135 !!! ierr = NF90_INQ_VARID(ncid,'OIceFrac',varid) 136 !!! ierr = NF90_GET_VAR(ncid,varid,freeze) 137 138 !!! ierr = NF90_INQ_VARID(ncid,'O_AlbIce',varid) 139 !!! ierr = NF90_GET_VAR(ncid,varid,alb_ice) 140 141 !!! ierr = NF90_INQ_VARID(ncid,'O_TepIce',varid) 142 !!! ierr = NF90_GET_VAR(ncid,varid,tn_ice) 143 144 !!! ierr = NF90_close(ncid) 130 145 131 146 !!! << Arnaud 132 147 133 IF ( TRIM(cn_rcv_qsr) == 'mixed oce-ice' ) CALL iom_get( numror, jpdom_local_full, 'alb_ice', alb_ice )134 148 !!!!! 135 149 !!!!! +++ ERIC tu utilises tn_ice dans le calcule de Qns, c'est bien ca??? 136 150 !!!!! 137 IF ( TRIM(cn_rcv_qns) == 'mixed oce-ice' ) CALL iom_get( numror, jpdom_local_full, 'tn_ice' , tn_ice ) 151 ! Eric : oui mais cette valeur est deja sauvee dans le restart glace 152 ! c est donc peut etre inutile de la sauver aussi dans le restart ocean 153 ! 154 ! IF ( TRIM(cn_rcv_qsr) == 'mixed oce-ice' ) CALL iom_get( numror, jpdom_local_full, 'alb_ice', alb_ice ) 155 ! IF ( TRIM(cn_rcv_qns) == 'mixed oce-ice' ) CALL iom_get( numror, jpdom_local_full, 'tn_ice' , tn_ice ) 138 156 139 157 ! default definitions of srcv … … 179 197 CASE( 'conservative' ) ; srcv( (/jprcv_rain, jprcv_snow, jprcv_ievp, jprcv_tevp/) )%laction = .TRUE. 180 198 CASE( 'oce and ice' ) ; srcv( (/ jprcv_tpre, jprcv_spre, jprcv_oemp/) )%laction = .TRUE. 181 CASE( 'mixed oce-ice' ) ; srcv( (/jprcv_rain, jprcv_spre,jprcv_tevp/) )%laction = .TRUE.199 CASE( 'mixed oce-ice' ) ; srcv( (/jprcv_rain, jprcv_snow, jprcv_tevp/) )%laction = .TRUE. 182 200 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_emp' ) 183 201 END SELECT … … 257 275 nrcv = nrcv + 1 ; jprcv_w10m = nrcv ; srcv(nrcv)%clname = 'O_Wind10' 258 276 IF ( TRIM(cn_rcv_w10m) == 'coupled' ) srcv(jprcv_w10m)%laction = .TRUE. 259 ! +++ ---> A brancher et a blinder dans tke si TRIM(cn_rcv_w10m) == 'none'277 ! ! +++ ---> A brancher et a blinder dans tke si TRIM(cn_rcv_w10m) == 'none' 260 278 261 279 !------------------------------------- … … 268 286 nrcv = nrcv + 1 ; jprcv_rnf = nrcv ; srcv(nrcv)%clname = 'O_Runoff' 269 287 IF ( TRIM(cn_rcv_rnf) /= 'climato' ) srcv(jprcv_rnf)%laction = .TRUE. 270 ! +++ ---> A brancher271 288 272 289 !------------------------------------- … … 321 338 ! Albedo 322 339 nsnd = nsnd + 1 ; jpsnd_albice = nsnd ; ssnd(nsnd)%clname = 'O_AlbIce' 323 nsnd = nsnd + 1 ; jpsnd_albmix = nsnd ;ssnd(nsnd)%clname = 'O_AlbMix'340 nsnd = nsnd + 1 ; jpsnd_albmix = nsnd ; ssnd(nsnd)%clname = 'O_AlbMix' 324 341 SELECT CASE (TRIM(cn_snd_albedo)) 325 342 CASE( 'none' ) ! nothing to do 326 343 CASE( 'weighted ice' ) ; ssnd(jpsnd_albice)%laction = .TRUE. 327 344 CASE( 'mixed oce-ice' ) ; ssnd(jpsnd_albmix)%laction = .TRUE. 345 CALL albedo_oce (albedo_oce_ov, albedo_oce_cs) 346 ! Due to lack of information on nebulosity 347 ! albedo = ( albedo clear sky + albedo overcast sky ) / 2 348 cpl_ocean_albedo = ( albedo_oce_cs + albedo_oce_ov ) / 2. 328 349 END SELECT 329 350 … … 336 357 !------------------------------------- 337 358 ! Surface current 338 nsnd = nsnd + 1 ; jpsnd_uoce = nsnd ; ssnd(nsnd)%clname = 'O_UN_Oce' 339 nsnd = nsnd + 1 ; jpsnd_voce = nsnd ; ssnd(nsnd)%clname = 'O_VN_OcE' 340 nsnd = nsnd + 1 ; jpsnd_uice = nsnd ; ssnd(nsnd)%clname = 'O_UN_Ice' 341 nsnd = nsnd + 1 ; jpsnd_vice = nsnd ; ssnd(nsnd)%clname = 'O_VN_IcE' 342 nsnd = nsnd + 1 ; jpsnd_umix = nsnd ; ssnd(nsnd)%clname = 'O_UN_Mix' 343 nsnd = nsnd + 1 ; jpsnd_vmix = nsnd ; ssnd(nsnd)%clname = 'O_VN_Mix' 344 ssnd(jpsnd_uoce:jpsnd_vmix)%nsgn = -1 359 nsnd = nsnd + 1 ; jpsnd_ocx1 = nsnd ; ssnd(nsnd)%clname = 'O_OCurx1' 360 nsnd = nsnd + 1 ; jpsnd_ocy1 = nsnd ; ssnd(nsnd)%clname = 'O_OCury1' 361 nsnd = nsnd + 1 ; jpsnd_ocz1 = nsnd ; ssnd(nsnd)%clname = 'O_OCurz1' 362 nsnd = nsnd + 1 ; jpsnd_ocx2 = nsnd ; ssnd(nsnd)%clname = 'O_OCurx2' 363 nsnd = nsnd + 1 ; jpsnd_ocy2 = nsnd ; ssnd(nsnd)%clname = 'O_OCury2' 364 nsnd = nsnd + 1 ; jpsnd_ocz2 = nsnd ; ssnd(nsnd)%clname = 'O_OCurz2' 365 ! Ice velocity 366 nsnd = nsnd + 1 ; jpsnd_ivx1 = nsnd ; ssnd(nsnd)%clname = 'O_IVelx1' 367 nsnd = nsnd + 1 ; jpsnd_ivy1 = nsnd ; ssnd(nsnd)%clname = 'O_IVely1' 368 nsnd = nsnd + 1 ; jpsnd_ivz1 = nsnd ; ssnd(nsnd)%clname = 'O_IVelz1' 369 nsnd = nsnd + 1 ; jpsnd_ivx2 = nsnd ; ssnd(nsnd)%clname = 'O_IVelx2' 370 nsnd = nsnd + 1 ; jpsnd_ivy2 = nsnd ; ssnd(nsnd)%clname = 'O_IVely2' 371 nsnd = nsnd + 1 ; jpsnd_ivz2 = nsnd ; ssnd(nsnd)%clname = 'O_IVelz2' 372 373 ssnd(jpsnd_ocx1:jpsnd_ivz2)%nsgn = -1 374 375 DO i = 1,3 376 cltmp(i) = cn_snd_current_4(i:i) 377 ENDDO 378 379 SELECT CASE (LEN_TRIM(cn_snd_current(4))) ! 'T' 'U,V' 380 CASE( 1 ) ! 'T' 381 ssnd(jpsnd_ocx1:jpsnd_ivz2)%clgrid = cltmp(1) ! all oce and ice components on the same unique grid 382 ssnd(jpsnd_ocx1:jpsnd_ocz1)%laction = .TRUE. ! oce components on 1 grid 383 ssnd(jpsnd_ivx1:jpsnd_ivz1)%laction = .TRUE. ! ice components on 1 grid 384 CASE( 3 ) ! 'U,V' 385 IF ( cltmp(3) /= 'V' ) CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_current(4)' ) 386 ssnd(jpsnd_ocx1:jpsnd_ocz1)%clgrid = cltmp(1) ! oce(ice) components on 2 grids 387 ssnd(jpsnd_ocx2:jpsnd_ocz2)%clgrid = cltmp(3) 388 ssnd(jpsnd_ivx1:jpsnd_ivz1)%clgrid = cltmp(1) 389 ssnd(jpsnd_ivx2:jpsnd_ivz2)%clgrid = cltmp(3) 390 ssnd(jpsnd_ocx1:jpsnd_ivz2)%laction = .TRUE. ! oce(ice) components on 2 grids 391 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_current(4)' ) 392 END SELECT 393 394 ! force .FALSE. to 3rd component for spherical coodinates 395 IF ( TRIM(cn_snd_current(2)) == 'spherical' ) ssnd((/jpsnd_ocz1, jpsnd_ocz2, jpsnd_ivz1, jpsnd_ivz2/))%laction = .FALSE. 396 345 397 SELECT CASE (TRIM(cn_snd_current(1))) 346 CASE( 'none' ) ! nothing to do347 CASE( 'oce only' ) ; ssnd( (/jpsnd_uoce, jpsnd_voce /) )%laction = .TRUE.348 CASE( 'weighted oce and ice' ) ; ssnd( (/jpsnd_uoce, jpsnd_voce, jpsnd_uice, jpsnd_vice/) )%laction = .TRUE.349 CASE( 'mixed oce-ice' ) ; ssnd( (/jpsnd_umix, jpsnd_vmix /) )%laction = .TRUE.398 CASE( 'none' ) ; ssnd( jpsnd_ocx1:jpsnd_ivz2 )%laction = .FALSE. 399 CASE( 'oce only' ) ; ssnd( jpsnd_ivx1:jpsnd_ivz2 )%laction = .FALSE. 400 CASE( 'weighted oce and ice' ) ! nothing to do 401 CASE( 'mixed oce-ice' ) ; ssnd( jpsnd_ivx1:jpsnd_ivz2 )%laction = .FALSE. 350 402 END SELECT 351 403 ! … … 361 413 SUBROUTINE sbc_cpl_rcv( kt ) 362 414 415 363 416 INTEGER :: kt, isec, info, ji, jj 364 417 … … 374 427 REAL(wp), DIMENSION(jpi,jpj) :: ztmpx1, ztmpx2, ztmpy1, ztmpy2 375 428 REAL(wp), DIMENSION(jpi,jpj), SAVE :: wind10_tmp, dqns_ice_tmp, rnfcpl_tmp, ocalving_tmp 429 ! Eric: question - ces tableaux tmp ne devraient-ils pas etre initialises a zero ? 376 430 377 431 IF( kt == nit000 ) CALL sbc_cpl_init … … 387 441 388 442 !!! Peut etre utiliser 389 ! !!IF ( srcv(jprcv_qsrmix)%laction ) qsr(:,:) = ( qsr_mix(:,:) - freeze(:,:) * qsr_ice(:,:) ) / (1. - freeze(:,:))443 ! IF ( srcv(jprcv_qsrmix)%laction ) qsr(:,:) = ( qsr_mix(:,:) - freeze(:,:) * qsr_ice(:,:) ) / (1. - freeze(:,:)) 390 444 !!! IF (( srcv(jprcv_qsroce)%laction ) .and. ( srcv(jprcv_qsrice)%laction )) then 391 !!! ztmp(:,:) = qsr_mix(:,:) / (1. - ( 0.065*(1. - freeze(:,:)) + freeze(:,:)*alb_ice(:,:)))445 !!! ztmp(:,:) = qsr_mix(:,:) / (1. - ( cpl_ocean_albedo(:,:)*(1. - freeze(:,:)) + freeze(:,:)*alb_ice(:,:))) 392 446 !!! qsr_ice(:,:) = ztmp(:,:) * (1. - alb_ice(:,:)) 393 !!! qsr (:,:) = ztmp(:,:) * (1. - 0.065)447 !!! qsr (:,:) = ztmp(:,:) * (1. - cpl_ocean_albedo(:,:)) 394 448 !!! endif 395 449 … … 402 456 qsr_ice(:,:) = qsr_ice_tmp(:,:) 403 457 CASE( 'mixed oce-ice' ) 404 ztmp(:,:) = qsr_mix(:,:) / (1. - ( 0.065*(1. - freeze(:,:)) + freeze(:,:)*alb_ice(:,:)))458 ztmp(:,:) = qsr_mix(:,:) / (1. - ( cpl_ocean_albedo(:,:)*(1. - freeze(:,:)) + freeze(:,:)*alb_ice(:,:))) 405 459 qsr_ice(:,:) = ztmp(:,:) * (1. - alb_ice(:,:)) 406 qsr (:,:) = ztmp(:,:) * (1. - 0.065) 407 END SELECT 460 qsr (:,:) = ztmp(:,:) * (1. - cpl_ocean_albedo(:,:)) 461 END SELECT 462 463 !------------------------------------- 464 ! d(Qns)/d(T) 465 ! Must be read before Qns for mixed oce-ice case 466 IF ( srcv(jprcv_dqnsdt)%laction ) CALL cpl_prism_rcv( jprcv_dqnsdt, isec, dqns_ice_tmp, info ) 467 dqns_ice(:,:) = dqns_ice_tmp(:,:) 408 468 409 469 !------------------------------------- … … 412 472 IF ( srcv(jprcv_qnsice)%laction ) CALL cpl_prism_rcv( jprcv_qnsice, isec, qns_ice_tmp, info ) 413 473 IF ( srcv(jprcv_qnsmix)%laction ) CALL cpl_prism_rcv( jprcv_qnsmix, isec, qns_mix, info ) 474 414 475 SELECT CASE (TRIM(cn_rcv_qns)) 415 476 CASE( 'conservative' ) … … 420 481 qns_ice(:,:) = qns_ice_tmp(:,:) 421 482 CASE( 'mixed oce-ice' ) 422 !!!!! 423 !!!!! +++ ERIC il faut que tu mettes les bonnes formules... 424 !!!!! 425 !!$ qns_ice(:,:) = ... 426 !!$ qns (:,:) = ... 483 484 ! Eric >> les valeurs freeze et tn_ice sont elles vraiment disponibles 485 ! a chaque pas de temps 486 ! dans la version precedente de NEMO, elles l etaient uniquement 487 ! pour MOD( kt-1, nfice ) == 0 488 489 ztmp(:,:) = tn_ice(:,:) * freeze(:,:) + ( tn(:,:,1) + rt0 ) * ( 1. - freeze(:,:) ) 490 qns(:,:) = qns_mix(:,:) + dqns_ice(:,:) * ( tn(:,:) + rt0 - ztmp(:,:) ) 491 qns_ice(:,:) = qns_mix(:,:) + dqns_ice(:,:) * ( tn_ice(:,:) - ztmp(:,:) ) 427 492 END SELECT 428 493 … … 451 516 emp(:,:) = emp_tmp(:,:) 452 517 CASE( 'mixed oce-ice' ) 453 tprecip(:,:) = zrain(:,:) + sprecip_tmp(:,:) 454 emp(:,:) = ztevp(:,:) - ( tprecip(:,:) + sprecip_tmp(:,:) ) 518 tprecip(:,:) = zrain(:,:) + zsnow(:,:) 519 sprecip(:,:) = zsnow(:,:) 520 emp(:,:) = ztevp(:,:) - tprecip(:,:) 455 521 END SELECT 456 522 … … 505 571 ENDIF 506 572 507 ! 'eastward-northward' to 'local grid' axes -> totate the components573 ! 'eastward-northward' to 'local grid' axes -> rotate the components 508 574 IF ( TRIM(cn_rcv_stress(3)) == 'eastward-northward' ) THEN ! Oce component 509 575 CALL rot_rep( zotx1, zoty1, srcv(jprcv_otx1)%clgrid, 'en->i', ztmpx1 ) ! 1st component on the 1st grid … … 588 654 ! +++ ---> blinder dans tke si TRIM(cn_rcv_w10m) == 'none' 589 655 IF ( srcv(jprcv_w10m )%laction ) CALL cpl_prism_rcv( jprcv_w10m, isec, wind10_tmp, info ) 590 !!! wind10m(:,:) = wind10_tmp(:,:) 591 592 !------------------------------------- 593 ! d(Qns)/d(T) 594 IF ( srcv(jprcv_dqnsdt)%laction ) CALL cpl_prism_rcv( jprcv_dqnsdt, isec, dqns_ice_tmp, info ) 595 dqns_ice(:,:) = dqns_ice_tmp(:,:) 656 ! wind10m(:,:) = wind10_tmp(:,:) 596 657 597 658 !------------------------------------- 598 659 ! Runoff 660 ! C a u t i o n : runoff must be positive and in kg/m2/s 661 ! 599 662 IF ( srcv(jprcv_rnf )%laction ) CALL cpl_prism_rcv( jprcv_rnf , isec, rnfcpl_tmp, info ) 600 663 rnfcpl(:,:) = rnfcpl_tmp(:,:) 601 664 ! 665 SELECT CASE (TRIM(cn_rcv_rnf)) 666 ! 667 CASE( 'climato' ) 668 ! 669 rnfcpl(:,:)=0. 670 ! 671 CASE( 'coupled' ) 672 ! 673 ! remove negative runoff 674 ! 675 mskpos(:,:)=0 ; mskneg(:,:)=0 676 ! 677 WHERE ( rnfcpl(:,:) < 0. ) mskneg(:,:)=1 ; WHERE ( rnfcpl(:,:) > 0. ) mskpos(:,:)=1 678 ! 679 zcumulpos=SUM(rnfcpl(:,:)*e1t(:,:)*e2t(:,:)*mskpos(:,:)) 680 zcumulneg=SUM(rnfcpl(:,:)*e1t(:,:)*e2t(:,:)*mskneg(:,:)) 681 ! 682 ! Eric: pas bien sur de ce mpp_sum la ... Seb ? 683 IF( lk_mpp ) CALL mpp_sum( zcumulpos ) ! sum over the global domain 684 IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 685 ! 686 IF ( zcumulpos /= 0. ) THEN ; zcumulneg = zcumulneg / zcumulpos 687 ELSE ; zcumulneg = 0 688 ENDIF 689 ! 690 ! distribute negative runoff on positive runoff grid points 691 ! 692 DO jj = 2, jpjm1 693 DO ji = fs_2, fs_jpim1 ! vector opt. 694 rnfcpl(ji,jj) = rnfcpl(ji,jj) * ( 1. + zcumulneg ) * mskpos(ji,jj) 695 ENDDO 696 ENDDO 697 ! 698 ! add runoff to e-p 699 ! 700 emp (:,:) = emp (:,:) - rnfcpl(:,:) 701 emps(:,:) = emps(:,:) - rnfcpl(:,:) 702 ! 703 CASE( 'mixed' ) 704 ! 705 ! sum to e-p to be done in sbc_rnf 706 ! 707 END SELECT 708 ! 602 709 !------------------------------------- 603 710 ! Calving 604 711 IF ( srcv(jprcv_cal )%laction ) CALL cpl_prism_rcv( jprcv_cal , isec, ocalving_tmp, info ) 605 712 ocalving(:,:) = ocalving_tmp(:,:) 713 emp (:,:) = emp (:,:) - ABS (ocalving(:,:)) 714 emps(:,:) = emps(:,:) - ABS (ocalving(:,:)) 606 715 607 716 ! fraction of net shortwave radiation which is not absorbed in the … … 616 725 SUBROUTINE sbc_cpl_snd( kt ) 617 726 618 USE oce, ONLY : tn 619 USE phycst, ONLY : rt0 620 621 INTEGER :: kt, isec, info 727 728 INTEGER :: kt, isec, info, ji, jj 622 729 REAL(wp), DIMENSION(jpi,jpj) :: ztmp 730 REAL(wp), DIMENSION(jpi,jpj) :: zotx1, zoty1, zotz1, zitx1, zity1, zitz1 731 REAL(wp), DIMENSION(jpi,jpj) :: zotx2, zoty2, zotz2, zitx2, zity2, zitz2 732 REAL(wp), DIMENSION(jpi,jpj) :: ztmpx1, ztmpy1, ztmpx2, ztmpy2 623 733 624 734 isec = ( kt - nit000 ) * NINT(rdttra(1)) ! date of exchanges … … 644 754 IF ( ssnd(jpsnd_albice)%laction ) CALL cpl_prism_snd( jpsnd_albice, isec, alb_ice(:,:) * freeze(:,:), info ) 645 755 IF ( ssnd(jpsnd_albmix)%laction ) THEN 646 !!!!! +++ ERIC ztmp(:,:) = albedo de l'ocean a definir... 647 CALL cpl_prism_snd( jpsnd_albmix, isec, ztmp(:,:) * (1. - freeze(:,:)) + alb_ice(:,:) * freeze(:,:), info ) 756 CALL cpl_prism_snd( jpsnd_albmix, isec, cpl_ocean_albedo * (1. - freeze(:,:)) + alb_ice(:,:) * freeze(:,:), info ) 648 757 ENDIF 649 758 … … 656 765 ! Surface current 657 766 658 !!! +++ seb ecriture des restarts... 767 !------------------------------------- 768 ! oce currents 769 770 zotx1(:,:) = un(:,:,1) 771 zoty1(:,:) = vn(:,:,1) 772 zitx1 = utaui_ice 773 zity1 = vtaui_ice 774 775 SELECT CASE (TRIM(cn_snd_current_1)) 776 CASE( 'oce only' ) ! nothing to do 777 CASE( 'weighted oce and ice' ) ; zotx1(:,:) = zotx1(:,:) * (1. - freeze(:,:)) ; zoty1(:,:) = zoty1(:,:) * freeze(:,:) 778 zitx1(:,:) = zitx1(:,:) * (1. - freeze(:,:)) ; zity1(:,:) = zity1(:,:) * freeze(:,:) 779 CASE( 'mixed oce-ice' ) ; zotx1(:,:) = zotx1(:,:) * (1. - freeze(:,:)) + zitx1(:,:)*freeze(:,:) ; zoty1 = zoty1(:,:) * (1. - freeze(:,:)) + zity1(:,:)*freeze(:,:) 780 END SELECT 781 782 zotx2(:,:) = zotx1(:,:) 783 zoty2(:,:) = zoty1(:,:) 784 zitx2(:,:) = zitx1(:,:) 785 zity2(:,:) = zity1(:,:) 786 787 IF ( ssnd(jpsnd_ocx1)%clgrid == 'T' ) THEN 788 ! Interpolate current on from U,V grid 789 DO jj = 2, jpjm1 790 DO ji = fs_2, fs_jpim1 ! vector opt. 791 zotx2(ji,jj) = 0.5 * ( zotx1(ji-1,jj ) + zotx1(ji,jj) ) ! U -> T grid 792 zoty2(ji,jj) = 0.5 * ( zoty1(ji ,jj-1) + zoty1(ji,jj) ) ! V -> T grid 793 END DO 794 END DO 795 ! Eric: 1 ou -1 pour le troisieme argument de lbc_lnk ? 796 CALL lbc_lnk( zotx2, 'T', 1. ) ; CALL lbc_lnk( zoty2, 'T', 1. ) 797 zotx1(:,:) = zotx2(:,:) 798 zoty1(:,:) = zoty2(:,:) 799 ! 800 IF ( ssnd(jpsnd_ivx1)%laction ) THEN 801 ! Interpolate ice velocities from I grid 802 DO jj = 2, jpjm1 803 DO ji = fs_2, fs_jpim1 ! vector opt. 804 zitx2(ji,jj) = 0.25 * ( zitx1(ji-1,jj ) + zitx1(ji ,jj ) + zitx1(ji-1,jj-1) + zitx1(ji ,jj-1) ) ! I -> T grid 805 zity2(ji,jj) = 0.25 * ( zity1(ji-1,jj ) + zity1(ji ,jj ) + zity1(ji-1,jj-1) + zity1(ji ,jj-1) ) ! I -> T grid 806 END DO 807 END DO 808 CALL lbc_lnk( zitx2, 'T', 1. ) ; CALL lbc_lnk( zity2, 'T', 1. ) 809 zitx1(:,:) = zitx2(:,:) 810 zity1(:,:) = zity2(:,:) 811 ! 812 ENDIF 813 ELSE IF ( ssnd(jpsnd_ivx1)%laction ) THEN 814 ! 815 ! Interpolate ice velocities from I grid 816 DO jj = 2, jpjm1 817 DO ji = fs_2, fs_jpim1 ! vector opt. 818 ztmpx1(ji,jj) = 0.5 * ( zitx1(ji+1,jj) + zitx1(ji+1,jj+1) ) ! I -> U grid 819 zitx2(ji,jj) = 0.5 * ( zitx1(ji,jj+1) + zitx1(ji+1,jj+1) ) ! I -> V grid 820 zitx1(ji,jj) = ztmpx1(ji,jj) 821 ztmpx1(ji,jj) = 0.5 * ( zity1(ji+1,jj) + zity1(ji+1,jj+1) ) ! I -> U grid 822 zity2(ji,jj) = 0.5 * ( zity1(ji,jj+1) + zity1(ji+1,jj+1) ) ! I -> V grid 823 zity1(ji,jj) = ztmpx1(ji,jj) 824 END DO 825 END DO 826 CALL lbc_lnk( zitx1, 'U', -1. ) ; CALL lbc_lnk( zity1, 'U', -1. ) 827 CALL lbc_lnk( zitx2, 'V', -1. ) ; CALL lbc_lnk( zity2, 'V', -1. ) 828 ! 829 ENDIF 830 831 ! 'local grid' to 'eastward-northward' axes -> rotate the components 832 IF ( TRIM(cn_snd_current(3)) == 'eastward-northward' ) THEN ! Oce component 833 ! 834 CALL rot_rep( zotx1, zoty1, ssnd(jpsnd_ocx1)%clgrid, 'ij->e', ztmpx1 ) ! 1st component on the 1st grid 835 zotx1(:,:) = ztmpx1(:,:) ! overwrite 1st component on the 1st grid 836 CALL rot_rep( zotx1, zoty1, srcv(jpsnd_ocx1)%clgrid, 'ij->n', ztmpy1 ) ! 2nd component on the 1st grid 837 zoty1(:,:) = ztmpy1(:,:) ! overwnrite 2nd component on the 1st grid 838 ! 839 IF ( ssnd(jpsnd_ocx2)%laction ) THEN 840 CALL rot_rep( zotx2, zoty2, ssnd(jpsnd_ocx2)%clgrid, 'ij->e', ztmpx2 ) ! 1st component on the 2nd grid 841 zotx2(:,:) = ztmpx2(:,:) ! overwrite 2nd component on the 2nd grid 842 CALL rot_rep( zotx2, zoty2, ssnd(jpsnd_ocy2)%clgrid, 'ij->n', ztmpy2 ) ! 2nd component on the 2nd grid 843 zoty2(:,:) = ztmpy2(:,:) ! overwrite 2nd component on the 2nd grid 844 ENDIF 845 ! 846 IF ( ssnd(jpsnd_ivx1)%laction ) THEN ! Ice component 847 CALL rot_rep( zitx1, zity1, ssnd(jpsnd_ivx1)%clgrid, 'ij->e', ztmpx1 ) ! 1st component on the 1st grid 848 zitx1(:,:) = ztmpx1(:,:) ! overwrite 1st component on the 1st grid 849 CALL rot_rep( zitx1, zity1, ssnd(jpsnd_ivx1)%clgrid, 'ij->n', ztmpy1 ) ! 2nd component on the 1st grid 850 zity1(:,:) = ztmpy1(:,:) ! overwrite 2nd component on the 1st grid 851 ! 852 IF ( ssnd(jpsnd_ivx2)%laction ) THEN 853 CALL rot_rep( zitx2, zity2, ssnd(jpsnd_ivx2)%clgrid, 'ij->e', ztmpx2 ) ! 1st component on the 2nd grid 854 zitx2(:,:) = ztmpx2(:,:) ! overwrite 2nd component on the 2nd grid 855 CALL rot_rep( zitx2, zity2, ssnd(jpsnd_ivx2)%clgrid, 'ij->n', ztmpy2 ) ! 2nd component on the 2nd grid 856 zity2(:,:) = ztmpy2(:,:) ! overwrite 2nd component on the 2nd grid 857 ELSE 858 ENDIF 859 ENDIF 860 ENDIF 861 862 ! Eric : Arnaud, je te laisse coder oce2geo ! 863 ! spherical coordinates to cartesian -> 2 components to 3 components 864 IF ( TRIM(cn_snd_current(2)) == 'cartesian' ) THEN 865 ! oceanic currents 866 ztmpx1(:,:) = zotx1(:,:) 867 ztmpy1(:,:) = zoty1(:,:) 868 SELECT CASE (ssnd(jpsnd_ocx1)%clgrid) 869 CASE( 'T' ) 870 CALL oce2geo ( ztmpx1, ztmpy1, 't', glamt, gphit, zotx1, zoty1, zotz1 ) ! 1st and 2nd components on the same grid 871 CASE( 'U' ) 872 CALL oce2geo ( ztmpx1, ztmpy1, 'u', glamu, gphiu, zotx1, zoty1, zotz1 ) ! 1st and 2nd components on the 1st grid 873 ztmpx2(:,:) = zotx2(:,:) 874 ztmpy2(:,:) = zoty2(:,:) 875 CALL oce2geo ( ztmpx2, ztmpy2, 'v', glamv, gphiv, zotx2, zoty2, zotz2 ) ! 1st and 2nd components on the 2nd grid 876 END SELECT 877 ! 878 ! ice velocities 879 IF ( ssnd(jpsnd_ivx1)%laction ) THEN 880 ztmpx1(:,:) = zitx1(:,:) 881 ztmpy1(:,:) = zity1(:,:) 882 SELECT CASE (ssnd(jpsnd_ivx1)%clgrid) 883 CASE( 'T' ) 884 CALL oce2geo ( ztmpx1, ztmpy1, 't', glamt, gphit, zitx1, zity1, zitz1 ) ! 1st and 2nd components on the same grid 885 CASE( 'U' ) 886 CALL oce2geo ( ztmpx1, ztmpy1, 'u', glamu, gphiu, zitx1, zity1, zitz1 ) ! 1st and 2nd components on the 1st grid 887 ztmpx2(:,:) = zitx2(:,:) 888 ztmpy2(:,:) = zity2(:,:) 889 CALL oce2geo ( ztmpx2, ztmpy2, 'v', glamv, gphiv, zitx2, zity2, zitz2 ) ! 1st and 2nd components on the 2nd grid 890 END SELECT 891 ENDIF 892 ENDIF 893 894 IF ( ssnd(jpsnd_ocx1)%laction ) CALL cpl_prism_snd( jpsnd_ocx1, isec, zotx1, info ) ! oce x current first grid 895 IF ( ssnd(jpsnd_ocy1)%laction ) CALL cpl_prism_snd( jpsnd_ocy1, isec, zoty1, info ) ! oce y current first grid 896 IF ( ssnd(jpsnd_ocz1)%laction ) CALL cpl_prism_snd( jpsnd_ocz1, isec, zotz1, info ) ! oce z current first grid 897 IF ( ssnd(jpsnd_ocx2)%laction ) CALL cpl_prism_snd( jpsnd_ocx2, isec, zotx2, info ) ! oce x current second grid 898 IF ( ssnd(jpsnd_ocy2)%laction ) CALL cpl_prism_snd( jpsnd_ocy2, isec, zoty2, info ) ! oce y current second grid 899 IF ( ssnd(jpsnd_ocz2)%laction ) CALL cpl_prism_snd( jpsnd_ocz2, isec, zotz2, info ) ! oce z current second grid 900 901 IF ( ssnd(jpsnd_ivx1)%laction ) CALL cpl_prism_snd( jpsnd_ivx1, isec, zitx1, info ) ! ice x current first grid 902 IF ( ssnd(jpsnd_ivy1)%laction ) CALL cpl_prism_snd( jpsnd_ivy1, isec, zity1, info ) ! ice y current first grid 903 IF ( ssnd(jpsnd_ivz1)%laction ) CALL cpl_prism_snd( jpsnd_ivz1, isec, zitz1, info ) ! ice z current first grid 904 IF ( ssnd(jpsnd_ivx2)%laction ) CALL cpl_prism_snd( jpsnd_ivx2, isec, zitx2, info ) ! ice x current second grid 905 IF ( ssnd(jpsnd_ivy2)%laction ) CALL cpl_prism_snd( jpsnd_ivy2, isec, zity2, info ) ! ice y current second grid 906 IF ( ssnd(jpsnd_ivz2)%laction ) CALL cpl_prism_snd( jpsnd_ivz2, isec, zitz2, info ) ! ice z current second grid 659 907 660 908 END SUBROUTINE sbc_cpl_snd
Note: See TracChangeset
for help on using the changeset viewer.
