- Timestamp:
- 2015-07-09T12:44:22+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5107_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5490 r5575 21 21 USE sbc_oce ! Surface boundary condition: ocean fields 22 22 USE sbc_ice ! Surface boundary condition: ice fields 23 USE sbcapr 23 24 USE sbcdcy ! surface boundary condition: diurnal cycle 24 25 USE phycst ! physical constants 25 26 #if defined key_lim3 26 USE par_ice ! ice parameters27 27 USE ice ! ice variables 28 28 #endif … … 33 33 USE cpl_oasis3 ! OASIS3 coupling 34 34 USE geo2ocean ! 35 USE oce , ONLY : tsn, un, vn 35 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 36 36 USE albedo ! 37 37 USE in_out_manager ! I/O manager … … 41 41 USE timing ! Timing 42 42 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 43 USE eosbn2 44 USE sbcrnf , ONLY : l_rnfcpl 43 45 #if defined key_cpl_carbon_cycle 44 46 USE p4zflx, ONLY : oce_co2 … … 47 49 USE ice_domain_size, only: ncat 48 50 #endif 51 #if defined key_lim3 52 USE limthd_dh ! for CALL lim_thd_snwblow 53 #endif 54 49 55 IMPLICIT NONE 50 56 PRIVATE 51 !EM XIOS-OASIS-MCT compliance 57 52 58 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 53 59 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90 … … 90 96 INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn 91 97 INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn 92 INTEGER, PARAMETER :: jprcv = 33 ! total number of fields received 93 94 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction 98 INTEGER, PARAMETER :: jpr_sflx = 34 ! salt flux 99 INTEGER, PARAMETER :: jpr_toce = 35 ! ocean temperature 100 INTEGER, PARAMETER :: jpr_soce = 36 ! ocean salinity 101 INTEGER, PARAMETER :: jpr_ocx1 = 37 ! ocean current on grid 1 102 INTEGER, PARAMETER :: jpr_ocy1 = 38 ! 103 INTEGER, PARAMETER :: jpr_ssh = 39 ! sea surface height 104 INTEGER, PARAMETER :: jpr_fice = 40 ! ice fraction 105 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 106 INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level 107 INTEGER, PARAMETER :: jprcv = 42 ! total number of fields received 108 109 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere 95 110 INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature 96 111 INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature … … 107 122 INTEGER, PARAMETER :: jps_ivz1 = 14 ! 108 123 INTEGER, PARAMETER :: jps_co2 = 15 109 INTEGER, PARAMETER :: jpsnd = 15 ! total number of fields sended 124 INTEGER, PARAMETER :: jps_soce = 16 ! ocean salinity 125 INTEGER, PARAMETER :: jps_ssh = 17 ! sea surface height 126 INTEGER, PARAMETER :: jps_qsroce = 18 ! Qsr above the ocean 127 INTEGER, PARAMETER :: jps_qnsoce = 19 ! Qns above the ocean 128 INTEGER, PARAMETER :: jps_oemp = 20 ! ocean freshwater budget (evap - precip) 129 INTEGER, PARAMETER :: jps_sflx = 21 ! salt flux 130 INTEGER, PARAMETER :: jps_otx1 = 22 ! 2 atmosphere-ocean stress components on grid 1 131 INTEGER, PARAMETER :: jps_oty1 = 23 ! 132 INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs 133 INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module 134 INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling) 135 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 136 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level 137 INTEGER, PARAMETER :: jpsnd = 28 ! total number of fields sended 110 138 111 139 ! !!** namelist namsbc_cpl ** … … 126 154 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 127 155 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 128 129 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask130 131 156 TYPE :: DYNARR 132 157 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 … … 140 165 141 166 !! Substitution 167 # include "domzgr_substitute.h90" 142 168 # include "vectopt_loop_substitute.h90" 143 169 !!---------------------------------------------------------------------- … … 162 188 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 163 189 #endif 164 ALLOCATE( xcplmask(jpi,jpj, nn_cplmodel) , STAT=ierr(3) )190 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 165 191 ! 166 192 sbc_cpl_alloc = MAXVAL( ierr ) … … 183 209 !! * initialise the OASIS coupler 184 210 !!---------------------------------------------------------------------- 185 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)211 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 186 212 !! 187 213 INTEGER :: jn ! dummy loop index … … 217 243 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 218 244 WRITE(numout,*)'~~~~~~~~~~~~' 245 ENDIF 246 IF( lwp .AND. ln_cpl ) THEN ! control print 219 247 WRITE(numout,*)' received fields (mutiple ice categogies)' 220 248 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' … … 364 392 srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip 365 393 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 394 CASE( 'none' ) ! nothing to do 366 395 CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE. 367 396 CASE( 'conservative' ) … … 375 404 ! ! Runoffs & Calving ! 376 405 ! ! ------------------------- ! 377 srcv(jpr_rnf )%clname = 'O_Runoff' ; IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 378 ! This isn't right - really just want ln_rnf_emp changed 379 ! IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' ) THEN ; ln_rnf = .TRUE. 380 ! ELSE ; ln_rnf = .FALSE. 381 ! ENDIF 406 srcv(jpr_rnf )%clname = 'O_Runoff' 407 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 408 srcv(jpr_rnf)%laction = .TRUE. 409 l_rnfcpl = .TRUE. ! -> no need to read runoffs in sbcrnf 410 ln_rnf = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas 411 IF(lwp) WRITE(numout,*) 412 IF(lwp) WRITE(numout,*) ' runoffs received from oasis -> force ln_rnf = ', ln_rnf 413 ENDIF 414 ! 382 415 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 383 416 … … 389 422 srcv(jpr_qnsmix)%clname = 'O_QnsMix' 390 423 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 424 CASE( 'none' ) ! nothing to do 391 425 CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE. 392 426 CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. … … 404 438 srcv(jpr_qsrmix)%clname = 'O_QsrMix' 405 439 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 440 CASE( 'none' ) ! nothing to do 406 441 CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE. 407 442 CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. … … 419 454 ! 420 455 ! non solar sensitivity mandatory for LIM ice model 421 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 ) &456 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) & 422 457 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 423 458 ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique … … 452 487 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 453 488 ENDIF 454 455 ! Allocate all parts of frcv used for received fields 489 ! ! ------------------------------- ! 490 ! ! OPA-SAS coupling - rcv by opa ! 491 ! ! ------------------------------- ! 492 srcv(jpr_sflx)%clname = 'O_SFLX' 493 srcv(jpr_fice)%clname = 'RIceFrc' 494 ! 495 IF( nn_components == jp_iam_opa ) THEN ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS) 496 srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 497 srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling 498 srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling 499 srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE. 500 srcv(jpr_otx1)%clgrid = 'U' ! oce components given at U-point 501 srcv(jpr_oty1)%clgrid = 'V' ! and V-point 502 ! Vectors: change of sign at north fold ONLY if on the local grid 503 srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1. 504 sn_rcv_tau%clvgrd = 'U,V' 505 sn_rcv_tau%clvor = 'local grid' 506 sn_rcv_tau%clvref = 'spherical' 507 sn_rcv_emp%cldes = 'oce only' 508 ! 509 IF(lwp) THEN ! control print 510 WRITE(numout,*) 511 WRITE(numout,*)' Special conditions for SAS-OPA coupling ' 512 WRITE(numout,*)' OPA component ' 513 WRITE(numout,*) 514 WRITE(numout,*)' received fields from SAS component ' 515 WRITE(numout,*)' ice cover ' 516 WRITE(numout,*)' oce only EMP ' 517 WRITE(numout,*)' salt flux ' 518 WRITE(numout,*)' mixed oce-ice solar flux ' 519 WRITE(numout,*)' mixed oce-ice non solar flux ' 520 WRITE(numout,*)' wind stress U,V on local grid and sperical coordinates ' 521 WRITE(numout,*)' wind stress module' 522 WRITE(numout,*) 523 ENDIF 524 ENDIF 525 ! ! -------------------------------- ! 526 ! ! OPA-SAS coupling - rcv by sas ! 527 ! ! -------------------------------- ! 528 srcv(jpr_toce )%clname = 'I_SSTSST' 529 srcv(jpr_soce )%clname = 'I_SSSal' 530 srcv(jpr_ocx1 )%clname = 'I_OCurx1' 531 srcv(jpr_ocy1 )%clname = 'I_OCury1' 532 srcv(jpr_ssh )%clname = 'I_SSHght' 533 srcv(jpr_e3t1st)%clname = 'I_E3T1st' 534 srcv(jpr_fraqsr)%clname = 'I_FraQsr' 535 ! 536 IF( nn_components == jp_iam_sas ) THEN 537 IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 538 IF( .NOT. ln_cpl ) srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling 539 IF( .NOT. ln_cpl ) srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling 540 srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE. 541 srcv( jpr_e3t1st )%laction = lk_vvl 542 srcv(jpr_ocx1)%clgrid = 'U' ! oce components given at U-point 543 srcv(jpr_ocy1)%clgrid = 'V' ! and V-point 544 ! Vectors: change of sign at north fold ONLY if on the local grid 545 srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1. 546 ! Change first letter to couple with atmosphere if already coupled OPA 547 ! this is nedeed as each variable name used in the namcouple must be unique: 548 ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere 549 DO jn = 1, jprcv 550 IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 551 END DO 552 ! 553 IF(lwp) THEN ! control print 554 WRITE(numout,*) 555 WRITE(numout,*)' Special conditions for SAS-OPA coupling ' 556 WRITE(numout,*)' SAS component ' 557 WRITE(numout,*) 558 IF( .NOT. ln_cpl ) THEN 559 WRITE(numout,*)' received fields from OPA component ' 560 ELSE 561 WRITE(numout,*)' Additional received fields from OPA component : ' 562 ENDIF 563 WRITE(numout,*)' sea surface temperature (Celcius) ' 564 WRITE(numout,*)' sea surface salinity ' 565 WRITE(numout,*)' surface currents ' 566 WRITE(numout,*)' sea surface height ' 567 WRITE(numout,*)' thickness of first ocean T level ' 568 WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level' 569 WRITE(numout,*) 570 ENDIF 571 ENDIF 572 573 ! =================================================== ! 574 ! Allocate all parts of frcv used for received fields ! 575 ! =================================================== ! 456 576 DO jn = 1, jprcv 457 577 IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) … … 459 579 ! Allocate taum part of frcv which is used even when not received as coupling field 460 580 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 581 ! Allocate w10m part of frcv which is used even when not received as coupling field 582 IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 583 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 584 IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 585 IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 461 586 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 462 587 IF( k_ice /= 0 ) THEN … … 482 607 ssnd(jps_tmix)%clname = 'O_TepMix' 483 608 SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 484 CASE( 'none' ) ! nothing to do485 CASE( 'oce only' ) ; ssnd( jps_toce)%laction = .TRUE.486 CASE( ' weighted oce and ice' )609 CASE( 'none' ) ! nothing to do 610 CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE. 611 CASE( 'oce and ice' , 'weighted oce and ice' ) 487 612 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 488 613 IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl 489 CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix)%laction = .TRUE.614 CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE. 490 615 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 491 616 END SELECT 492 617 493 618 ! ! ------------------------- ! 494 619 ! ! Albedo ! … … 497 622 ssnd(jps_albmix)%clname = 'O_AlbMix' 498 623 SELECT CASE( TRIM( sn_snd_alb%cldes ) ) 499 CASE( 'none' )! nothing to do500 CASE( ' weighted ice' ) ;ssnd(jps_albice)%laction = .TRUE.501 CASE( 'mixed oce-ice' ) ;ssnd(jps_albmix)%laction = .TRUE.624 CASE( 'none' ) ! nothing to do 625 CASE( 'ice' , 'weighted ice' ) ; ssnd(jps_albice)%laction = .TRUE. 626 CASE( 'mixed oce-ice' ) ; ssnd(jps_albmix)%laction = .TRUE. 502 627 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' ) 503 628 END SELECT … … 523 648 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 524 649 ENDIF 525 650 526 651 SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 527 652 CASE( 'none' ) ! nothing to do … … 530 655 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 531 656 ssnd(jps_hice:jps_hsnw)%nct = jpl 532 ELSE533 IF ( jpl > 1 ) THEN534 CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' )535 ENDIF536 657 ENDIF 537 658 CASE ( 'weighted ice and snow' ) … … 572 693 ! ! ------------------------- ! 573 694 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 695 696 ! ! ------------------------------- ! 697 ! ! OPA-SAS coupling - snd by opa ! 698 ! ! ------------------------------- ! 699 ssnd(jps_ssh )%clname = 'O_SSHght' 700 ssnd(jps_soce )%clname = 'O_SSSal' 701 ssnd(jps_e3t1st)%clname = 'O_E3T1st' 702 ssnd(jps_fraqsr)%clname = 'O_FraQsr' 703 ! 704 IF( nn_components == jp_iam_opa ) THEN 705 ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 706 ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE. 707 ssnd( jps_e3t1st )%laction = lk_vvl 708 ! vector definition: not used but cleaner... 709 ssnd(jps_ocx1)%clgrid = 'U' ! oce components given at U-point 710 ssnd(jps_ocy1)%clgrid = 'V' ! and V-point 711 sn_snd_crt%clvgrd = 'U,V' 712 sn_snd_crt%clvor = 'local grid' 713 sn_snd_crt%clvref = 'spherical' 714 ! 715 IF(lwp) THEN ! control print 716 WRITE(numout,*) 717 WRITE(numout,*)' sent fields to SAS component ' 718 WRITE(numout,*)' sea surface temperature (T before, Celcius) ' 719 WRITE(numout,*)' sea surface salinity ' 720 WRITE(numout,*)' surface currents U,V on local grid and spherical coordinates' 721 WRITE(numout,*)' sea surface height ' 722 WRITE(numout,*)' thickness of first ocean T level ' 723 WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level' 724 WRITE(numout,*) 725 ENDIF 726 ENDIF 727 ! ! ------------------------------- ! 728 ! ! OPA-SAS coupling - snd by sas ! 729 ! ! ------------------------------- ! 730 ssnd(jps_sflx )%clname = 'I_SFLX' 731 ssnd(jps_fice2 )%clname = 'IIceFrc' 732 ssnd(jps_qsroce)%clname = 'I_QsrOce' 733 ssnd(jps_qnsoce)%clname = 'I_QnsOce' 734 ssnd(jps_oemp )%clname = 'IOEvaMPr' 735 ssnd(jps_otx1 )%clname = 'I_OTaux1' 736 ssnd(jps_oty1 )%clname = 'I_OTauy1' 737 ssnd(jps_rnf )%clname = 'I_Runoff' 738 ssnd(jps_taum )%clname = 'I_TauMod' 739 ! 740 IF( nn_components == jp_iam_sas ) THEN 741 IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 742 ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE. 743 ! 744 ! Change first letter to couple with atmosphere if already coupled with sea_ice 745 ! this is nedeed as each variable name used in the namcouple must be unique: 746 ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 747 DO jn = 1, jpsnd 748 IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 749 END DO 750 ! 751 IF(lwp) THEN ! control print 752 WRITE(numout,*) 753 IF( .NOT. ln_cpl ) THEN 754 WRITE(numout,*)' sent fields to OPA component ' 755 ELSE 756 WRITE(numout,*)' Additional sent fields to OPA component : ' 757 ENDIF 758 WRITE(numout,*)' ice cover ' 759 WRITE(numout,*)' oce only EMP ' 760 WRITE(numout,*)' salt flux ' 761 WRITE(numout,*)' mixed oce-ice solar flux ' 762 WRITE(numout,*)' mixed oce-ice non solar flux ' 763 WRITE(numout,*)' wind stress U,V components' 764 WRITE(numout,*)' wind stress module' 765 ENDIF 766 ENDIF 767 574 768 ! 575 769 ! ================================ ! … … 577 771 ! ================================ ! 578 772 579 CALL cpl_define(jprcv, jpsnd,nn_cplmodel) 773 CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 774 580 775 IF (ln_usecplmask) THEN 581 776 xcplmask(:,:,:) = 0. … … 587 782 xcplmask(:,:,:) = 1. 588 783 ENDIF 589 ! 590 IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) ) & 784 xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 785 ! 786 ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' ) 787 IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 ) & 591 788 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 789 ncpl_qsr_freq = 86400 / ncpl_qsr_freq 592 790 593 791 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) … … 643 841 !! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 644 842 !!---------------------------------------------------------------------- 645 INTEGER, INTENT(in) :: kt ! ocean model time step index 646 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 647 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 648 !! 649 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 843 INTEGER, INTENT(in) :: kt ! ocean model time step index 844 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 845 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 846 847 !! 848 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 650 849 INTEGER :: ji, jj, jn ! dummy loop indices 651 850 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) … … 656 855 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 657 856 REAL(wp) :: zzx, zzy ! temporary variables 658 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty 857 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 659 858 !!---------------------------------------------------------------------- 660 859 ! 661 860 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 662 861 ! 663 CALL wrk_alloc( jpi,jpj, ztx, zty , ztx2, zty2) 664 ! ! Receive all the atmos. fields (including ice information) 665 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 666 DO jn = 1, jprcv ! received fields sent by the atmosphere 667 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) ) 862 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 863 ! 864 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 865 ! 866 ! ! ======================================================= ! 867 ! ! Receive all the atmos. fields (including ice information) 868 ! ! ======================================================= ! 869 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 870 DO jn = 1, jprcv ! received fields sent by the atmosphere 871 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 668 872 END DO 669 873 … … 747 951 ! 748 952 ENDIF 749 750 953 ! ! ========================= ! 751 954 ! ! wind stress module ! (taum) … … 776 979 ENDIF 777 980 ENDIF 778 981 ! 779 982 ! ! ========================= ! 780 983 ! ! 10 m wind speed ! (wndm) … … 789 992 !CDIR NOVERRCHK 790 993 DO ji = 1, jpi 791 wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )994 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 792 995 END DO 793 996 END DO 794 997 ENDIF 795 ELSE796 IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)797 998 ENDIF 798 999 … … 801 1002 IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 802 1003 ! 803 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 804 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 805 taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 1004 IF( ln_mixcpl ) THEN 1005 utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:) 1006 vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:) 1007 taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:) 1008 wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:) 1009 ELSE 1010 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 1011 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 1012 taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 1013 wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 1014 ENDIF 806 1015 CALL iom_put( "taum_oce", taum ) ! output wind stress module 807 1016 ! … … 809 1018 810 1019 #if defined key_cpl_carbon_cycle 811 ! ! atmosph. CO2 (ppm) 1020 ! ! ================== ! 1021 ! ! atmosph. CO2 (ppm) ! 1022 ! ! ================== ! 812 1023 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 813 1024 #endif 814 1025 1026 ! Fields received by SAS when OASIS coupling 1027 ! (arrays no more filled at sbcssm stage) 1028 ! ! ================== ! 1029 ! ! SSS ! 1030 ! ! ================== ! 1031 IF( srcv(jpr_soce)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1032 sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1) 1033 CALL iom_put( 'sss_m', sss_m ) 1034 ENDIF 1035 ! 1036 ! ! ================== ! 1037 ! ! SST ! 1038 ! ! ================== ! 1039 IF( srcv(jpr_toce)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1040 sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1) 1041 IF( srcv(jpr_soce)%laction .AND. ln_useCT ) THEN ! make sure that sst_m is the potential temperature 1042 sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) ) 1043 ENDIF 1044 ENDIF 1045 ! ! ================== ! 1046 ! ! SSH ! 1047 ! ! ================== ! 1048 IF( srcv(jpr_ssh )%laction ) THEN ! received by sas in case of opa <-> sas coupling 1049 ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1) 1050 CALL iom_put( 'ssh_m', ssh_m ) 1051 ENDIF 1052 ! ! ================== ! 1053 ! ! surface currents ! 1054 ! ! ================== ! 1055 IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1056 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1057 ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1058 CALL iom_put( 'ssu_m', ssu_m ) 1059 ENDIF 1060 IF( srcv(jpr_ocy1)%laction ) THEN 1061 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1062 vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1063 CALL iom_put( 'ssv_m', ssv_m ) 1064 ENDIF 1065 ! ! ======================== ! 1066 ! ! first T level thickness ! 1067 ! ! ======================== ! 1068 IF( srcv(jpr_e3t1st )%laction ) THEN ! received by sas in case of opa <-> sas coupling 1069 e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1) 1070 CALL iom_put( 'e3t_m', e3t_m(:,:) ) 1071 ENDIF 1072 ! ! ================================ ! 1073 ! ! fraction of solar net radiation ! 1074 ! ! ================================ ! 1075 IF( srcv(jpr_fraqsr)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1076 frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1) 1077 CALL iom_put( 'frq_m', frq_m ) 1078 ENDIF 1079 815 1080 ! ! ========================= ! 816 IF( k_ice <= 1 ) THEN! heat & freshwater fluxes ! (Ocean only case)1081 IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN ! heat & freshwater fluxes ! (Ocean only case) 817 1082 ! ! ========================= ! 818 1083 ! 819 1084 ! ! total freshwater fluxes over the ocean (emp) 820 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 821 CASE( 'conservative' ) 822 emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 823 CASE( 'oce only', 'oce and ice' ) 824 emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 825 CASE default 826 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 827 END SELECT 1085 IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN 1086 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 1087 CASE( 'conservative' ) 1088 zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 1089 CASE( 'oce only', 'oce and ice' ) 1090 zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 1091 CASE default 1092 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 1093 END SELECT 1094 ELSE 1095 zemp(:,:) = 0._wp 1096 ENDIF 828 1097 ! 829 1098 ! ! runoffs and calving (added in emp) 830 IF( srcv(jpr_rnf)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 831 IF( srcv(jpr_cal)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 832 ! 833 !!gm : this seems to be internal cooking, not sure to need that in a generic interface 834 !!gm at least should be optional... 835 !! IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN ! add to the total freshwater budget 836 !! ! remove negative runoff 837 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 838 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 839 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) ! sum over the global domain 840 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 841 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 842 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 843 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 844 !! ENDIF 845 !! ! add runoff to e-p 846 !! emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 847 !! ENDIF 848 !!gm end of internal cooking 1099 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1100 IF( srcv(jpr_cal)%laction ) zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 1101 1102 IF( ln_mixcpl ) THEN ; emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 1103 ELSE ; emp(:,:) = zemp(:,:) 1104 ENDIF 849 1105 ! 850 1106 ! ! non solar heat flux over the ocean (qns) 851 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 852 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1107 IF( srcv(jpr_qnsoce)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1108 ELSE IF( srcv(jpr_qnsmix)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1109 ELSE ; zqns(:,:) = 0._wp 1110 END IF 853 1111 ! update qns over the free ocean with: 854 qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 855 IF( srcv(jpr_snow )%laction ) THEN 856 qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean 1112 IF( nn_components /= jp_iam_opa ) THEN 1113 zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 1114 IF( srcv(jpr_snow )%laction ) THEN 1115 zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean 1116 ENDIF 1117 ENDIF 1118 IF( ln_mixcpl ) THEN ; qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) 1119 ELSE ; qns(:,:) = zqns(:,:) 857 1120 ENDIF 858 1121 859 1122 ! ! solar flux over the ocean (qsr) 860 IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 861 IF( srcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 862 IF( ln_dm2dc ) qsr(:,:) = sbc_dcy( qsr ) ! modify qsr to include the diurnal cycle 1123 IF ( srcv(jpr_qsroce)%laction ) THEN ; zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 1124 ELSE IF( srcv(jpr_qsrmix)%laction ) then ; zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 1125 ELSE ; zqsr(:,:) = 0._wp 1126 ENDIF 1127 IF( ln_dm2dc .AND. ln_cpl ) zqsr(:,:) = sbc_dcy( zqsr ) ! modify qsr to include the diurnal cycle 1128 IF( ln_mixcpl ) THEN ; qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:) 1129 ELSE ; qsr(:,:) = zqsr(:,:) 1130 ENDIF 863 1131 ! 864 865 ENDIF 866 ! 867 CALL wrk_dealloc( jpi,jpj, ztx, zty, ztx2, zty2) 1132 ! salt flux over the ocean (received by opa in case of opa <-> sas coupling) 1133 IF( srcv(jpr_sflx )%laction ) sfx(:,:) = frcv(jpr_sflx )%z3(:,:,1) 1134 ! Ice cover (received by opa in case of opa <-> sas coupling) 1135 IF( srcv(jpr_fice )%laction ) fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 1136 ! 1137 1138 ENDIF 1139 ! 1140 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 868 1141 ! 869 1142 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') … … 962 1235 ! 963 1236 ENDIF 964 965 1237 ! ! ======================= ! 966 1238 ! ! put on ice grid ! … … 1084 1356 1085 1357 1086 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist)1358 SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist ) 1087 1359 !!---------------------------------------------------------------------- 1088 1360 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1126 1398 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1127 1399 ! optional arguments, used only in 'mixed oce-ice' case 1128 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1129 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1130 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1131 ! 1132 INTEGER :: jl ! dummy loop index 1133 REAL(wp), POINTER, DIMENSION(:,:) :: zcptn, ztmp, zicefr 1400 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1401 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1402 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1403 ! 1404 INTEGER :: jl ! dummy loop index 1405 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk 1406 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot 1407 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice 1408 REAL(wp), POINTER, DIMENSION(:,: ) :: zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM3 1134 1409 !!---------------------------------------------------------------------- 1135 1410 ! 1136 1411 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1137 1412 ! 1138 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr ) 1139 1413 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1414 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1415 1416 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 1140 1417 zicefr(:,:) = 1.- p_frld(:,:) 1141 1418 zcptn(:,:) = rcp * sst_m(:,:) … … 1145 1422 ! ! ========================= ! 1146 1423 ! 1147 ! ! total Precipitations - total Evaporation (emp_tot) 1148 ! ! solid precipitation - sublimation (emp_ice) 1149 ! ! solid Precipitation (sprecip) 1424 ! ! total Precipitation - total Evaporation (emp_tot) 1425 ! ! solid precipitation - sublimation (emp_ice) 1426 ! ! solid Precipitation (sprecip) 1427 ! ! liquid + solid Precipitation (tprecip) 1150 1428 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1151 1429 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1152 sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)! May need to ensure positive here1153 tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:)! May need to ensure positive here1154 emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) -tprecip(:,:)1155 emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)1430 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1431 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1432 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1433 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1156 1434 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1157 1435 IF( iom_use('hflx_rain_cea') ) & … … 1164 1442 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) ) ! heat flux from from evap (cell average) 1165 1443 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1166 emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1167 emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1168 sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 1444 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1445 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1446 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1447 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 1169 1448 END SELECT 1449 1450 IF( iom_use('subl_ai_cea') ) & 1451 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1452 ! 1453 ! ! runoffs and calving (put in emp_tot) 1454 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1455 IF( srcv(jpr_cal)%laction ) THEN 1456 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1457 CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 1458 ENDIF 1459 1460 IF( ln_mixcpl ) THEN 1461 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1462 emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1463 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1464 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1465 ELSE 1466 emp_tot(:,:) = zemp_tot(:,:) 1467 emp_ice(:,:) = zemp_ice(:,:) 1468 sprecip(:,:) = zsprecip(:,:) 1469 tprecip(:,:) = ztprecip(:,:) 1470 ENDIF 1170 1471 1171 1472 CALL iom_put( 'snowpre' , sprecip ) ! Snow … … 1174 1475 IF( iom_use('snow_ai_cea') ) & 1175 1476 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1176 IF( iom_use('subl_ai_cea') ) &1177 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average)1178 !1179 ! ! runoffs and calving (put in emp_tot)1180 IF( srcv(jpr_rnf)%laction ) THEN1181 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)1182 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers1183 IF( iom_use('hflx_rnf_cea') ) &1184 CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers1185 ENDIF1186 IF( srcv(jpr_cal)%laction ) THEN1187 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)1188 CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) )1189 ENDIF1190 !1191 !!gm : this seems to be internal cooking, not sure to need that in a generic interface1192 !!gm at least should be optional...1193 !! ! remove negative runoff ! sum over the global domain1194 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1195 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1196 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos )1197 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg )1198 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points1199 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos1200 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg1201 !! ENDIF1202 !! emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) ! add runoff to e-p1203 !!1204 !!gm end of internal cooking1205 1477 1206 1478 ! ! ========================= ! … … 1208 1480 ! ! ========================= ! 1209 1481 CASE( 'oce only' ) ! the required field is directly provided 1210 qns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1)1482 zqns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1) 1211 1483 CASE( 'conservative' ) ! the required fields are directly provided 1212 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)1484 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1213 1485 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1214 qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)1486 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1215 1487 ELSE 1216 1488 ! Set all category values equal for the moment 1217 1489 DO jl=1,jpl 1218 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)1490 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1219 1491 ENDDO 1220 1492 ENDIF 1221 1493 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1222 qns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)1494 zqns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1223 1495 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1224 1496 DO jl=1,jpl 1225 qns_tot(:,: ) =qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)1226 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)1497 zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) 1498 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 1227 1499 ENDDO 1228 1500 ELSE 1501 qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1229 1502 DO jl=1,jpl 1230 qns_tot(:,: ) =qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1231 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)1503 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1504 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1232 1505 ENDDO 1233 1506 ENDIF 1234 1507 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1235 1508 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1236 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)1237 qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) &1509 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1510 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1238 1511 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1239 1512 & + pist(:,:,1) * zicefr(:,:) ) ) 1240 1513 END SELECT 1241 ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus1242 qns_tot(:,:) = qns_tot(:,:) & ! qns_tot update over free ocean with:1243 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting1244 & - ( emp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST)1245 & - emp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:)1246 IF( iom_use('hflx_snow_cea') ) &1247 CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average)1248 1514 !!gm 1249 !! currently it is taken into account in leads budget but not in the qns_tot, and thus not in1515 !! currently it is taken into account in leads budget but not in the zqns_tot, and thus not in 1250 1516 !! the flux that enter the ocean.... 1251 1517 !! moreover 1 - it is not diagnose anywhere.... … … 1256 1522 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1257 1523 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1258 qns_tot(:,:) =qns_tot(:,:) - ztmp(:,:)1524 zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 1259 1525 IF( iom_use('hflx_cal_cea') ) & 1260 1526 CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1261 1527 ENDIF 1528 1529 ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 1530 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1531 1532 #if defined key_lim3 1533 CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1534 1535 ! --- evaporation --- ! 1536 ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation 1537 ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice 1538 ! but it is incoherent WITH the ice model 1539 DO jl=1,jpl 1540 evap_ice(:,:,jl) = 0._wp ! should be: frcv(jpr_ievp)%z3(:,:,1) 1541 ENDDO 1542 zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 1543 1544 ! --- evaporation minus precipitation --- ! 1545 emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:) 1546 1547 ! --- non solar flux over ocean --- ! 1548 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax 1549 zqns_oce = 0._wp 1550 WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 1551 1552 ! --- heat flux associated with emp --- ! 1553 zsnw(:,:) = 0._wp 1554 CALL lim_thd_snwblow( p_frld, zsnw ) ! snow distribution over ice after wind blowing 1555 zqemp_oce(:,:) = - zevap(:,:) * p_frld(:,:) * zcptn(:,:) & ! evap 1556 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip 1557 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 1558 qemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1559 & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1560 1561 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1562 zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 1563 1564 ! --- total non solar flux --- ! 1565 zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:) 1566 1567 ! --- in case both coupled/forced are active, we must mix values --- ! 1568 IF( ln_mixcpl ) THEN 1569 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 1570 qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:) 1571 DO jl=1,jpl 1572 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1573 ENDDO 1574 qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:) 1575 qemp_oce (:,:) = qemp_oce(:,:) * xcplmask(:,:,0) + zqemp_oce(:,:)* zmsk(:,:) 1576 !!clem evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0) 1577 ELSE 1578 qns_tot (:,: ) = zqns_tot (:,: ) 1579 qns_oce (:,: ) = zqns_oce (:,: ) 1580 qns_ice (:,:,:) = zqns_ice (:,:,:) 1581 qprec_ice(:,:) = zqprec_ice(:,:) 1582 qemp_oce (:,:) = zqemp_oce (:,:) 1583 ENDIF 1584 1585 CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1586 #else 1587 1588 ! clem: this formulation is certainly wrong... but better than it was... 1589 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1590 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting 1591 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1592 & - zemp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:) 1593 1594 IF( ln_mixcpl ) THEN 1595 qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1596 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 1597 DO jl=1,jpl 1598 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1599 ENDDO 1600 ELSE 1601 qns_tot(:,: ) = zqns_tot(:,: ) 1602 qns_ice(:,:,:) = zqns_ice(:,:,:) 1603 ENDIF 1604 1605 #endif 1262 1606 1263 1607 ! ! ========================= ! … … 1265 1609 ! ! ========================= ! 1266 1610 CASE( 'oce only' ) 1267 qsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )1611 zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 1268 1612 CASE( 'conservative' ) 1269 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1613 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1270 1614 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1271 qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)1615 zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 1272 1616 ELSE 1273 1617 ! Set all category values equal for the moment 1274 1618 DO jl=1,jpl 1275 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)1619 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1276 1620 ENDDO 1277 1621 ENDIF 1278 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1279 qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)1622 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1623 zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1280 1624 CASE( 'oce and ice' ) 1281 qsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)1625 zqsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1282 1626 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1283 1627 DO jl=1,jpl 1284 qsr_tot(:,: ) =qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)1285 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)1628 zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) 1629 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 1286 1630 ENDDO 1287 1631 ELSE 1632 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1288 1633 DO jl=1,jpl 1289 qsr_tot(:,: ) =qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1290 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)1634 zqsr_tot(:,: ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1635 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1291 1636 ENDDO 1292 1637 ENDIF 1293 1638 CASE( 'mixed oce-ice' ) 1294 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1639 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1295 1640 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1296 1641 ! Create solar heat flux over ice using incoming solar heat flux and albedos 1297 1642 ! ( see OASIS3 user guide, 5th edition, p39 ) 1298 qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) &1643 zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1299 1644 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) & 1300 1645 & + palbi (:,:,1) * zicefr(:,:) ) ) 1301 1646 END SELECT 1302 IF( ln_dm2dc ) THEN ! modify qsr to include the diurnal cycle1303 qsr_tot(:,: ) = sbc_dcy(qsr_tot(:,: ) )1647 IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle 1648 zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) ) 1304 1649 DO jl=1,jpl 1305 qsr_ice(:,:,jl) = sbc_dcy(qsr_ice(:,:,jl) )1650 zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) ) 1306 1651 ENDDO 1652 ENDIF 1653 1654 #if defined key_lim3 1655 CALL wrk_alloc( jpi,jpj, zqsr_oce ) 1656 ! --- solar flux over ocean --- ! 1657 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax 1658 zqsr_oce = 0._wp 1659 WHERE( p_frld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:) 1660 1661 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) 1662 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF 1663 1664 CALL wrk_dealloc( jpi,jpj, zqsr_oce ) 1665 #endif 1666 1667 IF( ln_mixcpl ) THEN 1668 qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1669 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:) 1670 DO jl=1,jpl 1671 qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:) 1672 ENDDO 1673 ELSE 1674 qsr_tot(:,: ) = zqsr_tot(:,: ) 1675 qsr_ice(:,:,:) = zqsr_ice(:,:,:) 1307 1676 ENDIF 1308 1677 … … 1312 1681 CASE ('coupled') 1313 1682 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 1314 dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)1683 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 1315 1684 ELSE 1316 1685 ! Set all category values equal for the moment 1317 1686 DO jl=1,jpl 1318 dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)1687 zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 1319 1688 ENDDO 1320 1689 ENDIF 1321 1690 END SELECT 1322 1691 1692 IF( ln_mixcpl ) THEN 1693 DO jl=1,jpl 1694 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:) 1695 ENDDO 1696 ELSE 1697 dqns_ice(:,:,:) = zdqns_ice(:,:,:) 1698 ENDIF 1699 1323 1700 ! ! ========================= ! 1324 1701 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt ! … … 1336 1713 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1337 1714 1338 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) 1715 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1716 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1339 1717 ! 1340 1718 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') … … 1357 1735 INTEGER :: ikchoix 1358 1736 INTEGER :: isec, info ! local integer 1737 REAL(wp) :: zumax, zvmax 1359 1738 REAL(wp), POINTER, DIMENSION(:,:) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 1360 1739 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp3, ztmp4 … … 1373 1752 ! ! ------------------------- ! 1374 1753 IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 1375 SELECT CASE( sn_snd_temp%cldes) 1376 CASE( 'none' ) ! nothing to do 1377 CASE( 'oce only' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 1378 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1379 SELECT CASE( sn_snd_temp%clcat ) 1380 CASE( 'yes' ) 1381 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1382 CASE( 'no' ) 1383 ztmp3(:,:,:) = 0.0 1754 1755 IF ( nn_components == jp_iam_opa ) THEN 1756 ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part 1757 ELSE 1758 ! we must send the surface potential temperature 1759 IF( ln_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 1760 ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem) 1761 ENDIF 1762 ! 1763 SELECT CASE( sn_snd_temp%cldes) 1764 CASE( 'oce only' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0 1765 CASE( 'oce and ice' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0 1766 SELECT CASE( sn_snd_temp%clcat ) 1767 CASE( 'yes' ) 1768 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) 1769 CASE( 'no' ) 1770 WHERE( SUM( a_i, dim=3 ) /= 0. ) 1771 ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1772 ELSEWHERE 1773 ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?) 1774 END WHERE 1775 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1776 END SELECT 1777 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 1778 SELECT CASE( sn_snd_temp%clcat ) 1779 CASE( 'yes' ) 1780 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1781 CASE( 'no' ) 1782 ztmp3(:,:,:) = 0.0 1783 DO jl=1,jpl 1784 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 1785 ENDDO 1786 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1787 END SELECT 1788 CASE( 'mixed oce-ice' ) 1789 ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 1384 1790 DO jl=1,jpl 1385 ztmp 3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)1791 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1386 1792 ENDDO 1387 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )1793 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1388 1794 END SELECT 1389 CASE( 'mixed oce-ice' ) 1390 ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1391 DO jl=1,jpl 1392 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1393 ENDDO 1394 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1395 END SELECT 1795 ENDIF 1396 1796 IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1397 1797 IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info ) … … 1402 1802 ! ! ------------------------- ! 1403 1803 IF( ssnd(jps_albice)%laction ) THEN ! ice 1404 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1804 SELECT CASE( sn_snd_alb%cldes ) 1805 CASE( 'ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 1806 CASE( 'weighted ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1807 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 1808 END SELECT 1405 1809 CALL cpl_snd( jps_albice, isec, ztmp3, info ) 1406 1810 ENDIF … … 1415 1819 ! ! Ice fraction & Thickness ! 1416 1820 ! ! ------------------------- ! 1417 ! Send ice fraction field 1821 ! Send ice fraction field to atmosphere 1418 1822 IF( ssnd(jps_fice)%laction ) THEN 1419 1823 SELECT CASE( sn_snd_thick%clcat ) … … 1422 1826 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1423 1827 END SELECT 1424 CALL cpl_snd( jps_fice, isec, ztmp3, info ) 1828 IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info ) 1829 ENDIF 1830 1831 ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling) 1832 IF( ssnd(jps_fice2)%laction ) THEN 1833 ztmp3(:,:,1) = fr_i(:,:) 1834 IF( ssnd(jps_fice2)%laction ) CALL cpl_snd( jps_fice2, isec, ztmp3, info ) 1425 1835 ENDIF 1426 1836 … … 1443 1853 END SELECT 1444 1854 CASE( 'ice and snow' ) 1445 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 1446 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 1855 SELECT CASE( sn_snd_thick%clcat ) 1856 CASE( 'yes' ) 1857 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 1858 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 1859 CASE( 'no' ) 1860 WHERE( SUM( a_i, dim=3 ) /= 0. ) 1861 ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1862 ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1863 ELSEWHERE 1864 ztmp3(:,:,1) = 0. 1865 ztmp4(:,:,1) = 0. 1866 END WHERE 1867 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1868 END SELECT 1447 1869 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 1448 1870 END SELECT … … 1470 1892 ! i-1 i i 1471 1893 ! i i+1 (for I) 1472 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1473 CASE( 'oce only' ) ! C-grid ==> T 1474 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 1475 DO jj = 2, jpjm1 1476 DO ji = fs_2, fs_jpim1 ! vector opt. 1477 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1478 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1479 END DO 1480 END DO 1481 ELSE 1482 ! Temporarily Changed for UKV 1483 DO jj = 2, jpjm1 1484 DO ji = 2, jpim1 1485 zotx1(ji,jj) = un(ji,jj,1) 1486 zoty1(ji,jj) = vn(ji,jj,1) 1487 END DO 1488 END DO 1489 ENDIF 1490 CASE( 'weighted oce and ice' ) 1491 SELECT CASE ( cp_ice_msh ) 1492 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1493 DO jj = 2, jpjm1 1494 DO ji = fs_2, fs_jpim1 ! vector opt. 1495 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 1496 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 1497 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1498 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1499 END DO 1500 END DO 1501 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1502 DO jj = 2, jpjm1 1503 DO ji = 2, jpim1 ! NO vector opt. 1504 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 1505 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1506 zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1507 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1508 zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1509 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1510 END DO 1511 END DO 1512 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1513 DO jj = 2, jpjm1 1514 DO ji = 2, jpim1 ! NO vector opt. 1515 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 1516 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1517 zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1518 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1519 zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1520 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1521 END DO 1522 END DO 1523 END SELECT 1524 CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. ) 1525 CASE( 'mixed oce-ice' ) 1526 SELECT CASE ( cp_ice_msh ) 1527 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1528 DO jj = 2, jpjm1 1529 DO ji = fs_2, fs_jpim1 ! vector opt. 1530 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 1531 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1532 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 1533 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1534 END DO 1535 END DO 1536 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1537 DO jj = 2, jpjm1 1538 DO ji = 2, jpim1 ! NO vector opt. 1539 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1540 & + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1541 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1542 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1543 & + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1544 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1545 END DO 1546 END DO 1547 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1894 IF( nn_components == jp_iam_opa ) THEN 1895 zotx1(:,:) = un(:,:,1) 1896 zoty1(:,:) = vn(:,:,1) 1897 ELSE 1898 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1899 CASE( 'oce only' ) ! C-grid ==> T 1548 1900 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 1549 1901 DO jj = 2, jpjm1 1550 DO ji = 2, jpim1 ! NO vector opt. 1551 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj,1) ) * zfr_l(ji,jj) & 1552 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1553 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1554 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji,jj-1,1) ) * zfr_l(ji,jj) & 1555 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1556 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1557 END DO 1902 DO ji = fs_2, fs_jpim1 ! vector opt. 1903 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1904 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1905 END DO 1558 1906 END DO 1559 #if defined key_cice1560 1907 ELSE 1561 ! Temporarily Changed for HadGEM3 1908 ! Temporarily Changed for UKV 1909 DO jj = 2, jpjm1 1910 DO ji = 2, jpim1 1911 zotx1(ji,jj) = un(ji,jj,1) 1912 zoty1(ji,jj) = vn(ji,jj,1) 1913 END DO 1914 END DO 1915 ENDIF 1916 CASE( 'weighted oce and ice' ) 1917 SELECT CASE ( cp_ice_msh ) 1918 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1919 DO jj = 2, jpjm1 1920 DO ji = fs_2, fs_jpim1 ! vector opt. 1921 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 1922 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 1923 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1924 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1925 END DO 1926 END DO 1927 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1562 1928 DO jj = 2, jpjm1 1563 1929 DO ji = 2, jpim1 ! NO vector opt. 1564 zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1) & 1565 & + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) ) 1566 zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1) & 1567 & + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) ) 1930 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 1931 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1932 zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1933 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1934 zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1935 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1568 1936 END DO 1569 1937 END DO 1938 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1939 DO jj = 2, jpjm1 1940 DO ji = 2, jpim1 ! NO vector opt. 1941 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 1942 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1943 zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1944 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1945 zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1946 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1947 END DO 1948 END DO 1949 END SELECT 1950 CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. ) 1951 CASE( 'mixed oce-ice' ) 1952 SELECT CASE ( cp_ice_msh ) 1953 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1954 DO jj = 2, jpjm1 1955 DO ji = fs_2, fs_jpim1 ! vector opt. 1956 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 1957 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1958 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 1959 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1960 END DO 1961 END DO 1962 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1963 DO jj = 2, jpjm1 1964 DO ji = 2, jpim1 ! NO vector opt. 1965 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1966 & + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1967 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1968 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1969 & + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1970 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1971 END DO 1972 END DO 1973 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1974 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 1975 DO jj = 2, jpjm1 1976 DO ji = 2, jpim1 ! NO vector opt. 1977 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj,1) ) * zfr_l(ji,jj) & 1978 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1979 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1980 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji,jj-1,1) ) * zfr_l(ji,jj) & 1981 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1982 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1983 END DO 1984 #if defined key_cice 1985 ELSE 1986 ! Temporarily Changed for HadGEM3 1987 DO jj = 2, jpjm1 1988 DO ji = 2, jpim1 ! NO vector opt. 1989 zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1) & 1990 & + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) ) 1991 zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1) & 1992 & + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) ) 1993 END DO 1994 END DO 1570 1995 #endif 1571 ENDIF 1996 ENDIF 1997 END SELECT 1572 1998 END SELECT 1573 END SELECT 1574 CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 1999 CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 2000 ! 2001 ENDIF 1575 2002 ! 1576 2003 ! … … 1636 2063 ENDIF 1637 2064 ! 2065 ! 2066 ! Fields sent by OPA to SAS when doing OPA<->SAS coupling 2067 ! ! SSH 2068 IF( ssnd(jps_ssh )%laction ) THEN 2069 ! ! removed inverse barometer ssh when Patm 2070 ! forcing is used (for sea-ice dynamics) 2071 IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 2072 ELSE ; ztmp1(:,:) = sshn(:,:) 2073 ENDIF 2074 CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info ) 2075 2076 ENDIF 2077 ! ! SSS 2078 IF( ssnd(jps_soce )%laction ) THEN 2079 CALL cpl_snd( jps_soce , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info ) 2080 ENDIF 2081 ! ! first T level thickness 2082 IF( ssnd(jps_e3t1st )%laction ) THEN 2083 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1) , (/jpi,jpj,1/) ), info ) 2084 ENDIF 2085 ! ! Qsr fraction 2086 IF( ssnd(jps_fraqsr)%laction ) THEN 2087 CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info ) 2088 ENDIF 2089 ! 2090 ! Fields sent by SAS to OPA when OASIS coupling 2091 ! ! Solar heat flux 2092 IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info ) 2093 IF( ssnd(jps_qnsoce)%laction ) CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info ) 2094 IF( ssnd(jps_oemp )%laction ) CALL cpl_snd( jps_oemp , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info ) 2095 IF( ssnd(jps_sflx )%laction ) CALL cpl_snd( jps_sflx , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info ) 2096 IF( ssnd(jps_otx1 )%laction ) CALL cpl_snd( jps_otx1 , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info ) 2097 IF( ssnd(jps_oty1 )%laction ) CALL cpl_snd( jps_oty1 , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info ) 2098 IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) 2099 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 2100 1638 2101 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 1639 2102 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )
Note: See TracChangeset
for help on using the changeset viewer.