- Timestamp:
- 2015-06-19T17:18:00+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5377 r5443 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 45 47 #endif 48 #if defined key_cice 49 USE ice_domain_size, only: ncat 50 #endif 51 #if defined key_lim3 52 USE limthd_dh ! for CALL lim_thd_snwblow 53 #endif 54 46 55 IMPLICIT NONE 47 56 PRIVATE 48 !EM XIOS-OASIS-MCT compliance 57 49 58 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 50 59 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90 … … 88 97 INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn 89 98 INTEGER, PARAMETER :: jpr_ts_ice = 34 ! skin temperature of sea-ice (used for melt-ponds) 90 INTEGER, PARAMETER :: jprcv = 34 ! total number of fields received 91 92 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction 99 INTEGER, PARAMETER :: jpr_sflx = 34 ! salt flux 100 INTEGER, PARAMETER :: jpr_toce = 35 ! ocean temperature 101 INTEGER, PARAMETER :: jpr_soce = 36 ! ocean salinity 102 INTEGER, PARAMETER :: jpr_ocx1 = 37 ! ocean current on grid 1 103 INTEGER, PARAMETER :: jpr_ocy1 = 38 ! 104 INTEGER, PARAMETER :: jpr_ssh = 39 ! sea surface height 105 INTEGER, PARAMETER :: jpr_fice = 40 ! ice fraction 106 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 107 INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level 108 INTEGER, PARAMETER :: jprcv = 42 ! total number of fields received 109 110 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere 93 111 INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature 94 112 INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature … … 107 125 INTEGER, PARAMETER :: jps_a_p = 16 ! meltpond fraction 108 126 INTEGER, PARAMETER :: jps_ht_p = 17 ! meltpond depth (m) 109 INTEGER, PARAMETER :: jpsnd = 18 ! total number of fields sent 127 INTEGER, PARAMETER :: jps_soce = 16 ! ocean salinity 128 INTEGER, PARAMETER :: jps_ssh = 17 ! sea surface height 129 INTEGER, PARAMETER :: jps_qsroce = 18 ! Qsr above the ocean 130 INTEGER, PARAMETER :: jps_qnsoce = 19 ! Qns above the ocean 131 INTEGER, PARAMETER :: jps_oemp = 20 ! ocean freshwater budget (evap - precip) 132 INTEGER, PARAMETER :: jps_sflx = 21 ! salt flux 133 INTEGER, PARAMETER :: jps_otx1 = 22 ! 2 atmosphere-ocean stress components on grid 1 134 INTEGER, PARAMETER :: jps_oty1 = 23 ! 135 INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs 136 INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module 137 INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling) 138 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 139 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level 140 INTEGER, PARAMETER :: jpsnd = 28 ! total number of fields sended 141 110 142 ! !!** namelist namsbc_cpl ** 111 143 TYPE :: FLD_C … … 125 157 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 126 158 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 127 128 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask129 130 159 TYPE :: DYNARR 131 160 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 … … 139 168 140 169 !! Substitution 170 # include "domzgr_substitute.h90" 141 171 # include "vectopt_loop_substitute.h90" 142 172 !!---------------------------------------------------------------------- … … 161 191 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 162 192 #endif 163 ALLOCATE( xcplmask(jpi,jpj, nn_cplmodel) , STAT=ierr(3) )193 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 164 194 ! 165 195 sbc_cpl_alloc = MAXVAL( ierr ) … … 182 212 !! * initialise the OASIS coupler 183 213 !!---------------------------------------------------------------------- 184 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)214 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 185 215 !! 186 216 INTEGER :: jn ! dummy loop index … … 217 247 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 218 248 WRITE(numout,*)'~~~~~~~~~~~~' 249 ENDIF 250 IF( lwp .AND. ln_cpl ) THEN ! control print 219 251 WRITE(numout,*)' received fields (mutiple ice categogies)' 220 252 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' … … 361 393 srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip 362 394 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 395 CASE( 'none' ) ! nothing to do 363 396 CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE. 364 397 CASE( 'conservative' ) … … 374 407 ! ! Runoffs & Calving ! 375 408 ! ! ------------------------- ! 376 srcv(jpr_rnf )%clname = 'O_Runoff' ; IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 377 ! This isn't right - really just want ln_rnf_emp changed 378 ! IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' ) THEN ; ln_rnf = .TRUE. 379 ! ELSE ; ln_rnf = .FALSE. 380 ! ENDIF 409 srcv(jpr_rnf )%clname = 'O_Runoff' 410 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 411 srcv(jpr_rnf)%laction = .TRUE. 412 l_rnfcpl = .TRUE. ! -> no need to read runoffs in sbcrnf 413 ln_rnf = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas 414 IF(lwp) WRITE(numout,*) 415 IF(lwp) WRITE(numout,*) ' runoffs received from oasis -> force ln_rnf = ', ln_rnf 416 ENDIF 417 ! 381 418 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 382 419 … … 388 425 srcv(jpr_qnsmix)%clname = 'O_QnsMix' 389 426 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 427 CASE( 'none' ) ! nothing to do 390 428 CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE. 391 429 CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. … … 403 441 srcv(jpr_qsrmix)%clname = 'O_QsrMix' 404 442 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 443 CASE( 'none' ) ! nothing to do 405 444 CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE. 406 445 CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. … … 418 457 ! 419 458 ! non solar sensitivity mandatory for LIM ice model 420 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 ) &459 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) & 421 460 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 422 461 ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique … … 465 504 466 505 ! Allocate all parts of frcv used for received fields 506 ! ! ------------------------------- ! 507 ! ! OPA-SAS coupling - rcv by opa ! 508 ! ! ------------------------------- ! 509 srcv(jpr_sflx)%clname = 'O_SFLX' 510 srcv(jpr_fice)%clname = 'RIceFrc' 511 ! 512 IF( nn_components == jp_iam_opa ) THEN ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS) 513 srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 514 srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling 515 srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling 516 srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE. 517 srcv(jpr_otx1)%clgrid = 'U' ! oce components given at U-point 518 srcv(jpr_oty1)%clgrid = 'V' ! and V-point 519 ! Vectors: change of sign at north fold ONLY if on the local grid 520 srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1. 521 sn_rcv_tau%clvgrd = 'U,V' 522 sn_rcv_tau%clvor = 'local grid' 523 sn_rcv_tau%clvref = 'spherical' 524 sn_rcv_emp%cldes = 'oce only' 525 ! 526 IF(lwp) THEN ! control print 527 WRITE(numout,*) 528 WRITE(numout,*)' Special conditions for SAS-OPA coupling ' 529 WRITE(numout,*)' OPA component ' 530 WRITE(numout,*) 531 WRITE(numout,*)' received fields from SAS component ' 532 WRITE(numout,*)' ice cover ' 533 WRITE(numout,*)' oce only EMP ' 534 WRITE(numout,*)' salt flux ' 535 WRITE(numout,*)' mixed oce-ice solar flux ' 536 WRITE(numout,*)' mixed oce-ice non solar flux ' 537 WRITE(numout,*)' wind stress U,V on local grid and sperical coordinates ' 538 WRITE(numout,*)' wind stress module' 539 WRITE(numout,*) 540 ENDIF 541 ENDIF 542 ! ! -------------------------------- ! 543 ! ! OPA-SAS coupling - rcv by sas ! 544 ! ! -------------------------------- ! 545 srcv(jpr_toce )%clname = 'I_SSTSST' 546 srcv(jpr_soce )%clname = 'I_SSSal' 547 srcv(jpr_ocx1 )%clname = 'I_OCurx1' 548 srcv(jpr_ocy1 )%clname = 'I_OCury1' 549 srcv(jpr_ssh )%clname = 'I_SSHght' 550 srcv(jpr_e3t1st)%clname = 'I_E3T1st' 551 srcv(jpr_fraqsr)%clname = 'I_FraQsr' 552 ! 553 IF( nn_components == jp_iam_sas ) THEN 554 IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 555 IF( .NOT. ln_cpl ) srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling 556 IF( .NOT. ln_cpl ) srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling 557 srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE. 558 srcv( jpr_e3t1st )%laction = lk_vvl 559 srcv(jpr_ocx1)%clgrid = 'U' ! oce components given at U-point 560 srcv(jpr_ocy1)%clgrid = 'V' ! and V-point 561 ! Vectors: change of sign at north fold ONLY if on the local grid 562 srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1. 563 ! Change first letter to couple with atmosphere if already coupled OPA 564 ! this is nedeed as each variable name used in the namcouple must be unique: 565 ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere 566 DO jn = 1, jprcv 567 IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 568 END DO 569 ! 570 IF(lwp) THEN ! control print 571 WRITE(numout,*) 572 WRITE(numout,*)' Special conditions for SAS-OPA coupling ' 573 WRITE(numout,*)' SAS component ' 574 WRITE(numout,*) 575 IF( .NOT. ln_cpl ) THEN 576 WRITE(numout,*)' received fields from OPA component ' 577 ELSE 578 WRITE(numout,*)' Additional received fields from OPA component : ' 579 ENDIF 580 WRITE(numout,*)' sea surface temperature (Celcius) ' 581 WRITE(numout,*)' sea surface salinity ' 582 WRITE(numout,*)' surface currents ' 583 WRITE(numout,*)' sea surface height ' 584 WRITE(numout,*)' thickness of first ocean T level ' 585 WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level' 586 WRITE(numout,*) 587 ENDIF 588 ENDIF 589 590 ! =================================================== ! 591 ! Allocate all parts of frcv used for received fields ! 592 ! =================================================== ! 467 593 DO jn = 1, jprcv 468 594 IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) … … 470 596 ! Allocate taum part of frcv which is used even when not received as coupling field 471 597 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 598 ! Allocate w10m part of frcv which is used even when not received as coupling field 599 IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 600 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 601 IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 602 IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 472 603 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 473 604 IF( k_ice /= 0 ) THEN … … 493 624 ssnd(jps_tmix)%clname = 'O_TepMix' 494 625 SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 495 CASE( 'none' ) ! nothing to do496 CASE( 'oce only' ) ; ssnd( jps_toce)%laction = .TRUE.497 CASE( ' weighted oce and ice' )626 CASE( 'none' ) ! nothing to do 627 CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE. 628 CASE( 'oce and ice' , 'weighted oce and ice' ) 498 629 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 499 630 IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl 500 CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix)%laction = .TRUE.631 CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE. 501 632 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 502 633 END SELECT 503 634 504 635 ! ! ------------------------- ! 505 636 ! ! Albedo ! … … 508 639 ssnd(jps_albmix)%clname = 'O_AlbMix' 509 640 SELECT CASE( TRIM( sn_snd_alb%cldes ) ) 510 CASE( 'none' )! nothing to do511 CASE( ' weighted ice' ) ;ssnd(jps_albice)%laction = .TRUE.512 CASE( 'mixed oce-ice' ) ;ssnd(jps_albmix)%laction = .TRUE.641 CASE( 'none' ) ! nothing to do 642 CASE( 'ice' , 'weighted ice' ) ; ssnd(jps_albice)%laction = .TRUE. 643 CASE( 'mixed oce-ice' ) ; ssnd(jps_albmix)%laction = .TRUE. 513 644 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' ) 514 645 END SELECT … … 536 667 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 537 668 ENDIF 538 669 539 670 SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 540 671 CASE( 'none' ) ! nothing to do … … 543 674 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 544 675 ssnd(jps_hice:jps_hsnw)%nct = jpl 545 ELSE546 IF ( jpl > 1 ) THEN547 CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' )548 ENDIF549 676 ENDIF 550 677 CASE ( 'weighted ice and snow' ) … … 622 749 ! ! ------------------------- ! 623 750 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 751 752 ! ! ------------------------------- ! 753 ! ! OPA-SAS coupling - snd by opa ! 754 ! ! ------------------------------- ! 755 ssnd(jps_ssh )%clname = 'O_SSHght' 756 ssnd(jps_soce )%clname = 'O_SSSal' 757 ssnd(jps_e3t1st)%clname = 'O_E3T1st' 758 ssnd(jps_fraqsr)%clname = 'O_FraQsr' 759 ! 760 IF( nn_components == jp_iam_opa ) THEN 761 ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 762 ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE. 763 ssnd( jps_e3t1st )%laction = lk_vvl 764 ! vector definition: not used but cleaner... 765 ssnd(jps_ocx1)%clgrid = 'U' ! oce components given at U-point 766 ssnd(jps_ocy1)%clgrid = 'V' ! and V-point 767 sn_snd_crt%clvgrd = 'U,V' 768 sn_snd_crt%clvor = 'local grid' 769 sn_snd_crt%clvref = 'spherical' 770 ! 771 IF(lwp) THEN ! control print 772 WRITE(numout,*) 773 WRITE(numout,*)' sent fields to SAS component ' 774 WRITE(numout,*)' sea surface temperature (T before, Celcius) ' 775 WRITE(numout,*)' sea surface salinity ' 776 WRITE(numout,*)' surface currents U,V on local grid and spherical coordinates' 777 WRITE(numout,*)' sea surface height ' 778 WRITE(numout,*)' thickness of first ocean T level ' 779 WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level' 780 WRITE(numout,*) 781 ENDIF 782 ENDIF 783 ! ! ------------------------------- ! 784 ! ! OPA-SAS coupling - snd by sas ! 785 ! ! ------------------------------- ! 786 ssnd(jps_sflx )%clname = 'I_SFLX' 787 ssnd(jps_fice2 )%clname = 'IIceFrc' 788 ssnd(jps_qsroce)%clname = 'I_QsrOce' 789 ssnd(jps_qnsoce)%clname = 'I_QnsOce' 790 ssnd(jps_oemp )%clname = 'IOEvaMPr' 791 ssnd(jps_otx1 )%clname = 'I_OTaux1' 792 ssnd(jps_oty1 )%clname = 'I_OTauy1' 793 ssnd(jps_rnf )%clname = 'I_Runoff' 794 ssnd(jps_taum )%clname = 'I_TauMod' 795 ! 796 IF( nn_components == jp_iam_sas ) THEN 797 IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 798 ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE. 799 ! 800 ! Change first letter to couple with atmosphere if already coupled with sea_ice 801 ! this is nedeed as each variable name used in the namcouple must be unique: 802 ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 803 DO jn = 1, jpsnd 804 IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 805 END DO 806 ! 807 IF(lwp) THEN ! control print 808 WRITE(numout,*) 809 IF( .NOT. ln_cpl ) THEN 810 WRITE(numout,*)' sent fields to OPA component ' 811 ELSE 812 WRITE(numout,*)' Additional sent fields to OPA component : ' 813 ENDIF 814 WRITE(numout,*)' ice cover ' 815 WRITE(numout,*)' oce only EMP ' 816 WRITE(numout,*)' salt flux ' 817 WRITE(numout,*)' mixed oce-ice solar flux ' 818 WRITE(numout,*)' mixed oce-ice non solar flux ' 819 WRITE(numout,*)' wind stress U,V components' 820 WRITE(numout,*)' wind stress module' 821 ENDIF 822 ENDIF 823 624 824 ! 625 825 ! ================================ ! … … 627 827 ! ================================ ! 628 828 629 CALL cpl_define(jprcv, jpsnd,nn_cplmodel) 829 CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 830 630 831 IF (ln_usecplmask) THEN 631 832 xcplmask(:,:,:) = 0. … … 637 838 xcplmask(:,:,:) = 1. 638 839 ENDIF 639 ! 640 IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) ) & 840 xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 841 ! 842 ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'S_QsrOce' ) + cpl_freq( 'S_QsrMix' ) 843 IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 ) & 641 844 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 845 ncpl_qsr_freq = 86400 / ncpl_qsr_freq 642 846 643 847 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) … … 693 897 !! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 694 898 !!---------------------------------------------------------------------- 695 INTEGER, INTENT(in) :: kt ! ocean model time step index 696 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 697 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 698 !! 699 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 899 INTEGER, INTENT(in) :: kt ! ocean model time step index 900 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 901 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 902 903 !! 904 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 700 905 INTEGER :: ji, jj, jl, jn ! dummy loop indices 701 906 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) … … 705 910 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 706 911 REAL(wp) :: zzx, zzy ! temporary variables 707 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty 912 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr 708 913 !!---------------------------------------------------------------------- 709 914 ! 710 915 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 711 916 ! 712 CALL wrk_alloc( jpi,jpj, ztx, zty ) 713 ! ! Receive all the atmos. fields (including ice information) 714 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 715 DO jn = 1, jprcv ! received fields sent by the atmosphere 716 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) ) 917 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 918 ! 919 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 920 ! 921 ! ! ======================================================= ! 922 ! ! Receive all the atmos. fields (including ice information) 923 ! ! ======================================================= ! 924 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 925 DO jn = 1, jprcv ! received fields sent by the atmosphere 926 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 717 927 END DO 718 928 … … 774 984 ! 775 985 ENDIF 776 777 986 ! ! ========================= ! 778 987 ! ! wind stress module ! (taum) … … 803 1012 ENDIF 804 1013 ENDIF 805 1014 ! 806 1015 ! ! ========================= ! 807 1016 ! ! 10 m wind speed ! (wndm) … … 816 1025 !CDIR NOVERRCHK 817 1026 DO ji = 1, jpi 818 wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )1027 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 819 1028 END DO 820 1029 END DO 821 1030 ENDIF 822 ELSE823 IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)824 1031 ENDIF 825 1032 … … 828 1035 IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 829 1036 ! 830 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 831 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 832 taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 1037 IF( ln_mixcpl ) THEN 1038 utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:) 1039 vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:) 1040 taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:) 1041 wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:) 1042 ELSE 1043 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 1044 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 1045 taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 1046 wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 1047 ENDIF 833 1048 CALL iom_put( "taum_oce", taum ) ! output wind stress module 834 1049 ! … … 836 1051 837 1052 #if defined key_cpl_carbon_cycle 838 ! ! atmosph. CO2 (ppm) 1053 ! ! ================== ! 1054 ! ! atmosph. CO2 (ppm) ! 1055 ! ! ================== ! 839 1056 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 840 1057 #endif … … 860 1077 ENDIF 861 1078 #endif 1079 ! Fields received by SAS when OASIS coupling 1080 ! (arrays no more filled at sbcssm stage) 1081 ! ! ================== ! 1082 ! ! SSS ! 1083 ! ! ================== ! 1084 IF( srcv(jpr_soce)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1085 sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1) 1086 CALL iom_put( 'sss_m', sss_m ) 1087 ENDIF 1088 ! 1089 ! ! ================== ! 1090 ! ! SST ! 1091 ! ! ================== ! 1092 IF( srcv(jpr_toce)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1093 sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1) 1094 IF( srcv(jpr_soce)%laction .AND. ln_useCT ) THEN ! make sure that sst_m is the potential temperature 1095 sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) ) 1096 ENDIF 1097 ENDIF 1098 ! ! ================== ! 1099 ! ! SSH ! 1100 ! ! ================== ! 1101 IF( srcv(jpr_ssh )%laction ) THEN ! received by sas in case of opa <-> sas coupling 1102 ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1) 1103 CALL iom_put( 'ssh_m', ssh_m ) 1104 ENDIF 1105 ! ! ================== ! 1106 ! ! surface currents ! 1107 ! ! ================== ! 1108 IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1109 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1110 ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1111 CALL iom_put( 'ssu_m', ssu_m ) 1112 ENDIF 1113 IF( srcv(jpr_ocy1)%laction ) THEN 1114 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1115 vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1116 CALL iom_put( 'ssv_m', ssv_m ) 1117 ENDIF 1118 ! ! ======================== ! 1119 ! ! first T level thickness ! 1120 ! ! ======================== ! 1121 IF( srcv(jpr_e3t1st )%laction ) THEN ! received by sas in case of opa <-> sas coupling 1122 e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1) 1123 CALL iom_put( 'e3t_m', e3t_m(:,:) ) 1124 ENDIF 1125 ! ! ================================ ! 1126 ! ! fraction of solar net radiation ! 1127 ! ! ================================ ! 1128 IF( srcv(jpr_fraqsr)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1129 frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1) 1130 CALL iom_put( 'frq_m', frq_m ) 1131 ENDIF 1132 862 1133 ! ! ========================= ! 863 IF( k_ice <= 1 ) THEN! heat & freshwater fluxes ! (Ocean only case)1134 IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN ! heat & freshwater fluxes ! (Ocean only case) 864 1135 ! ! ========================= ! 865 1136 ! 866 1137 ! ! total freshwater fluxes over the ocean (emp) 867 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 868 CASE( 'conservative' ) 869 emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 870 CASE( 'oce only', 'oce and ice' ) 871 emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 872 CASE default 873 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 874 END SELECT 1138 IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN 1139 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 1140 CASE( 'conservative' ) 1141 zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 1142 CASE( 'oce only', 'oce and ice' ) 1143 zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 1144 CASE default 1145 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 1146 END SELECT 1147 ELSE 1148 zemp(:,:) = 0._wp 1149 ENDIF 875 1150 ! 876 1151 ! ! runoffs and calving (added in emp) 877 IF( srcv(jpr_rnf)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 878 IF( srcv(jpr_cal)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 879 ! 880 !!gm : this seems to be internal cooking, not sure to need that in a generic interface 881 !!gm at least should be optional... 882 !! IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN ! add to the total freshwater budget 883 !! ! remove negative runoff 884 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 885 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 886 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) ! sum over the global domain 887 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 888 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 889 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 890 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 891 !! ENDIF 892 !! ! add runoff to e-p 893 !! emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 894 !! ENDIF 895 !!gm end of internal cooking 1152 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1153 IF( srcv(jpr_cal)%laction ) zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 1154 1155 IF( ln_mixcpl ) THEN ; emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 1156 ELSE ; emp(:,:) = zemp(:,:) 1157 ENDIF 896 1158 ! 897 1159 ! ! non solar heat flux over the ocean (qns) 898 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 899 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1160 IF( srcv(jpr_qnsoce)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1161 ELSE IF( srcv(jpr_qnsmix)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1162 ELSE ; zqns(:,:) = 0._wp 1163 END IF 900 1164 ! update qns over the free ocean with: 901 qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 902 IF( srcv(jpr_snow )%laction ) THEN 903 qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean 1165 IF( nn_components /= jp_iam_opa ) THEN 1166 zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 1167 IF( srcv(jpr_snow )%laction ) THEN 1168 zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean 1169 ENDIF 1170 ENDIF 1171 IF( ln_mixcpl ) THEN ; qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) 1172 ELSE ; qns(:,:) = zqns(:,:) 904 1173 ENDIF 905 1174 906 1175 ! ! solar flux over the ocean (qsr) 907 IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 908 IF( srcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 909 IF( ln_dm2dc ) qsr(:,:) = sbc_dcy( qsr ) ! modify qsr to include the diurnal cycle 1176 IF ( srcv(jpr_qsroce)%laction ) THEN ; zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 1177 ELSE IF( srcv(jpr_qsrmix)%laction ) then ; zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 1178 ELSE ; zqsr(:,:) = 0._wp 1179 ENDIF 1180 IF( ln_dm2dc .AND. ln_cpl ) zqsr(:,:) = sbc_dcy( zqsr ) ! modify qsr to include the diurnal cycle 1181 IF( ln_mixcpl ) THEN ; qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:) 1182 ELSE ; qsr(:,:) = zqsr(:,:) 1183 ENDIF 910 1184 ! 911 912 ENDIF 913 ! 914 CALL wrk_dealloc( jpi,jpj, ztx, zty ) 1185 ! salt flux over the ocean (received by opa in case of opa <-> sas coupling) 1186 IF( srcv(jpr_sflx )%laction ) sfx(:,:) = frcv(jpr_sflx )%z3(:,:,1) 1187 ! Ice cover (received by opa in case of opa <-> sas coupling) 1188 IF( srcv(jpr_fice )%laction ) fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 1189 ! 1190 1191 ENDIF 1192 ! 1193 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 915 1194 ! 916 1195 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') … … 1009 1288 ! 1010 1289 ENDIF 1011 1012 1290 ! ! ======================= ! 1013 1291 ! ! put on ice grid ! … … 1131 1409 1132 1410 1133 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist)1411 SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist ) 1134 1412 !!---------------------------------------------------------------------- 1135 1413 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1173 1451 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1174 1452 ! optional arguments, used only in 'mixed oce-ice' case 1175 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1176 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1177 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1178 ! 1179 INTEGER :: jl ! dummy loop index 1180 REAL(wp), POINTER, DIMENSION(:,:) :: zcptn, ztmp, zicefr 1453 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1454 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1455 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1456 ! 1457 INTEGER :: jl ! dummy loop index 1458 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk 1459 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot 1460 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice 1461 REAL(wp), POINTER, DIMENSION(:,: ) :: zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ! for LIM3 1181 1462 !!---------------------------------------------------------------------- 1182 1463 ! 1183 1464 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1184 1465 ! 1185 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr ) 1186 1466 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1467 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1468 1469 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 1187 1470 zicefr(:,:) = 1.- p_frld(:,:) 1188 1471 zcptn(:,:) = rcp * sst_m(:,:) … … 1192 1475 ! ! ========================= ! 1193 1476 ! 1194 ! ! total Precipitations - total Evaporation (emp_tot) 1195 ! ! solid precipitation - sublimation (emp_ice) 1196 ! ! solid Precipitation (sprecip) 1477 ! ! total Precipitation - total Evaporation (emp_tot) 1478 ! ! solid precipitation - sublimation (emp_ice) 1479 ! ! solid Precipitation (sprecip) 1480 ! ! liquid + solid Precipitation (tprecip) 1197 1481 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1198 1482 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1199 sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1200 tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here 1201 emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 1483 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1484 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1485 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1486 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1202 1487 #if defined key_cice 1203 1488 IF ( TRIM(sn_rcv_emp%clcat) == 'yes' ) THEN 1204 1489 ! emp_ice is the sum of frcv(jpr_ievp)%z3(:,:,1) over all layers - snow 1205 emp_ice(:,:) = - frcv(jpr_snow)%z3(:,:,1)1490 zemp_ice(:,:) = - frcv(jpr_snow)%z3(:,:,1) 1206 1491 DO jl=1,jpl 1207 emp_ice(:,: ) =emp_ice(:,:) + frcv(jpr_ievp)%z3(:,:,jl)1492 zemp_ice(:,: ) = zemp_ice(:,:) + frcv(jpr_ievp)%z3(:,:,jl) 1208 1493 ENDDO 1209 1494 ! latent heat coupled for each category in CICE … … 1214 1499 ! The latent heat flux is split between the ice categories according 1215 1500 ! to the fraction of the ice in each category 1216 emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)1501 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1217 1502 WHERE ( zicefr(:,:) /= 0._wp ) 1218 1503 ztmp(:,:) = 1./zicefr(:,:) … … 1226 1511 ENDIF 1227 1512 #else 1228 emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)1513 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1229 1514 #endif 1230 1515 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation … … 1238 1523 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) ) ! heat flux from from evap (cell average) 1239 1524 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1240 emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1241 emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1242 sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 1525 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1526 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1527 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1528 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 1243 1529 END SELECT 1530 1531 IF( iom_use('subl_ai_cea') ) & 1532 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1533 ! 1534 ! ! runoffs and calving (put in emp_tot) 1535 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1536 IF( srcv(jpr_cal)%laction ) THEN 1537 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1538 CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 1539 ENDIF 1540 1541 IF( ln_mixcpl ) THEN 1542 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1543 emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1544 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1545 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1546 ELSE 1547 emp_tot(:,:) = zemp_tot(:,:) 1548 emp_ice(:,:) = zemp_ice(:,:) 1549 sprecip(:,:) = zsprecip(:,:) 1550 tprecip(:,:) = ztprecip(:,:) 1551 ENDIF 1244 1552 1245 1553 CALL iom_put( 'snowpre' , sprecip ) ! Snow … … 1248 1556 IF( iom_use('snow_ai_cea') ) & 1249 1557 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1250 IF( iom_use('subl_ai_cea') ) &1251 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average)1252 !1253 ! ! runoffs and calving (put in emp_tot)1254 IF( srcv(jpr_rnf)%laction ) THEN1255 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)1256 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers1257 IF( iom_use('hflx_rnf_cea') ) &1258 CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers1259 ENDIF1260 IF( srcv(jpr_cal)%laction ) THEN1261 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)1262 CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) )1263 ENDIF1264 !1265 !!gm : this seems to be internal cooking, not sure to need that in a generic interface1266 !!gm at least should be optional...1267 !! ! remove negative runoff ! sum over the global domain1268 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1269 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1270 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos )1271 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg )1272 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points1273 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos1274 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg1275 !! ENDIF1276 !! emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) ! add runoff to e-p1277 !!1278 !!gm end of internal cooking1279 1558 1280 1559 ! ! ========================= ! … … 1282 1561 ! ! ========================= ! 1283 1562 CASE( 'oce only' ) ! the required field is directly provided 1284 qns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1)1563 zqns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1) 1285 1564 CASE( 'conservative' ) ! the required fields are directly provided 1286 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)1565 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1287 1566 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1288 qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)1567 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1289 1568 ELSE 1290 1569 ! Set all category values equal for the moment 1291 1570 DO jl=1,jpl 1292 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)1571 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1293 1572 ENDDO 1294 1573 ENDIF 1295 1574 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1296 qns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)1575 zqns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1297 1576 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1298 1577 DO jl=1,jpl 1299 qns_tot(:,: ) =qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)1300 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)1578 zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) 1579 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 1301 1580 ENDDO 1302 1581 ELSE 1582 qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1303 1583 DO jl=1,jpl 1304 qns_tot(:,: ) =qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1305 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)1584 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1585 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1306 1586 ENDDO 1307 1587 ENDIF 1308 1588 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1309 1589 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1310 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)1311 qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) &1590 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1591 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1312 1592 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1313 1593 & + pist(:,:,1) * zicefr(:,:) ) ) 1314 1594 END SELECT 1315 ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus1316 qns_tot(:,:) = qns_tot(:,:) & ! qns_tot update over free ocean with:1317 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting1318 & - ( emp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST)1319 & - emp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:)1320 IF( iom_use('hflx_snow_cea') ) &1321 CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average)1322 1595 !!gm 1323 !! currently it is taken into account in leads budget but not in the qns_tot, and thus not in1596 !! currently it is taken into account in leads budget but not in the zqns_tot, and thus not in 1324 1597 !! the flux that enter the ocean.... 1325 1598 !! moreover 1 - it is not diagnose anywhere.... … … 1330 1603 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1331 1604 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1332 qns_tot(:,:) =qns_tot(:,:) - ztmp(:,:)1605 zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 1333 1606 IF( iom_use('hflx_cal_cea') ) & 1334 1607 CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1335 1608 ENDIF 1609 1610 ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 1611 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1612 1613 #if defined key_lim3 1614 CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1615 1616 ! --- evaporation --- ! 1617 ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation 1618 ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice 1619 ! but it is incoherent WITH the ice model 1620 DO jl=1,jpl 1621 evap_ice(:,:,jl) = 0._wp ! should be: frcv(jpr_ievp)%z3(:,:,1) 1622 ENDDO 1623 zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 1624 1625 ! --- evaporation minus precipitation --- ! 1626 emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:) 1627 1628 ! --- non solar flux over ocean --- ! 1629 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax 1630 zqns_oce = 0._wp 1631 WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 1632 1633 ! --- heat flux associated with emp --- ! 1634 CALL lim_thd_snwblow( p_frld, zsnw ) ! snow distribution over ice after wind blowing 1635 zqemp_oce(:,:) = - zevap(:,:) * p_frld(:,:) * zcptn(:,:) & ! evap 1636 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip 1637 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 1638 qemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1639 & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1640 1641 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1642 zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 1643 1644 ! --- total non solar flux --- ! 1645 zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:) 1646 1647 ! --- in case both coupled/forced are active, we must mix values --- ! 1648 IF( ln_mixcpl ) THEN 1649 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 1650 qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:) 1651 DO jl=1,jpl 1652 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1653 ENDDO 1654 qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:) 1655 qemp_oce (:,:) = qemp_oce(:,:) * xcplmask(:,:,0) + zqemp_oce(:,:)* zmsk(:,:) 1656 !!clem evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0) 1657 ELSE 1658 qns_tot (:,: ) = zqns_tot (:,: ) 1659 qns_oce (:,: ) = zqns_oce (:,: ) 1660 qns_ice (:,:,:) = zqns_ice (:,:,:) 1661 qprec_ice(:,:) = zqprec_ice(:,:) 1662 qemp_oce (:,:) = zqemp_oce (:,:) 1663 ENDIF 1664 1665 CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1666 1667 #else 1668 1669 ! clem: this formulation is certainly wrong... but better than it was... 1670 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1671 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting 1672 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1673 & - zemp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:) 1674 1675 IF( ln_mixcpl ) THEN 1676 qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1677 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 1678 DO jl=1,jpl 1679 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1680 ENDDO 1681 ELSE 1682 qns_tot(:,: ) = zqns_tot(:,: ) 1683 qns_ice(:,:,:) = zqns_ice(:,:,:) 1684 ENDIF 1685 1686 #endif 1336 1687 1337 1688 ! ! ========================= ! … … 1339 1690 ! ! ========================= ! 1340 1691 CASE( 'oce only' ) 1341 qsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )1692 zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 1342 1693 CASE( 'conservative' ) 1343 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1694 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1344 1695 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1345 qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)1696 zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 1346 1697 ELSE 1347 1698 ! Set all category values equal for the moment 1348 1699 DO jl=1,jpl 1349 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)1700 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1350 1701 ENDDO 1351 1702 ENDIF 1352 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1353 qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)1703 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1704 zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1354 1705 CASE( 'oce and ice' ) 1355 qsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)1706 zqsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1356 1707 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1357 1708 DO jl=1,jpl 1358 qsr_tot(:,: ) =qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)1359 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)1709 zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) 1710 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 1360 1711 ENDDO 1361 1712 ELSE 1713 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1362 1714 DO jl=1,jpl 1363 qsr_tot(:,: ) =qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1364 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)1715 zqsr_tot(:,: ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1716 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1365 1717 ENDDO 1366 1718 ENDIF 1367 1719 CASE( 'mixed oce-ice' ) 1368 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1720 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1369 1721 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1370 1722 ! Create solar heat flux over ice using incoming solar heat flux and albedos 1371 1723 ! ( see OASIS3 user guide, 5th edition, p39 ) 1372 qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) &1724 zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1373 1725 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) & 1374 1726 & + palbi (:,:,1) * zicefr(:,:) ) ) 1375 1727 END SELECT 1376 IF( ln_dm2dc ) THEN ! modify qsr to include the diurnal cycle1377 qsr_tot(:,: ) = sbc_dcy(qsr_tot(:,: ) )1728 IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle 1729 zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) ) 1378 1730 DO jl=1,jpl 1379 qsr_ice(:,:,jl) = sbc_dcy(qsr_ice(:,:,jl) )1731 zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) ) 1380 1732 ENDDO 1733 ENDIF 1734 1735 IF( ln_mixcpl ) THEN 1736 qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1737 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:) 1738 DO jl=1,jpl 1739 qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:) 1740 ENDDO 1741 ELSE 1742 qsr_tot(:,: ) = zqsr_tot(:,: ) 1743 qsr_ice(:,:,:) = zqsr_ice(:,:,:) 1381 1744 ENDIF 1382 1745 … … 1386 1749 CASE ('coupled') 1387 1750 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 1388 dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)1751 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 1389 1752 ELSE 1390 1753 ! Set all category values equal for the moment 1391 1754 DO jl=1,jpl 1392 dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)1755 zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 1393 1756 ENDDO 1394 1757 ENDIF 1395 1758 END SELECT 1396 1759 1760 IF( ln_mixcpl ) THEN 1761 DO jl=1,jpl 1762 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:) 1763 ENDDO 1764 ELSE 1765 dqns_ice(:,:,:) = zdqns_ice(:,:,:) 1766 ENDIF 1767 1397 1768 ! ! ========================= ! 1398 1769 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt ! … … 1410 1781 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1411 1782 1412 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) 1783 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1784 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1413 1785 ! 1414 1786 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') … … 1430 1802 INTEGER :: ji, jj, jl ! dummy loop indices 1431 1803 INTEGER :: isec, info ! local integer 1804 REAL(wp) :: zumax, zvmax 1432 1805 REAL(wp), POINTER, DIMENSION(:,:) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 1433 1806 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp3, ztmp4 … … 1446 1819 ! ! ------------------------- ! 1447 1820 IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 1448 SELECT CASE( sn_snd_temp%cldes) 1449 CASE( 'oce only' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 1450 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1451 SELECT CASE( sn_snd_temp%clcat ) 1452 CASE( 'yes' ) 1453 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1454 CASE( 'no' ) 1455 ztmp3(:,:,:) = 0.0 1821 1822 IF ( nn_components == jp_iam_opa ) THEN 1823 ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part 1824 ELSE 1825 ! we must send the surface potential temperature 1826 IF( ln_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 1827 ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem) 1828 ENDIF 1829 ! 1830 SELECT CASE( sn_snd_temp%cldes) 1831 CASE( 'oce only' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0 1832 CASE( 'oce and ice' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0 1833 SELECT CASE( sn_snd_temp%clcat ) 1834 CASE( 'yes' ) 1835 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) 1836 CASE( 'no' ) 1837 WHERE( SUM( a_i, dim=3 ) /= 0. ) 1838 ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1839 ELSEWHERE 1840 ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?) 1841 END WHERE 1842 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1843 END SELECT 1844 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 1845 SELECT CASE( sn_snd_temp%clcat ) 1846 CASE( 'yes' ) 1847 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1848 CASE( 'no' ) 1849 ztmp3(:,:,:) = 0.0 1850 DO jl=1,jpl 1851 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 1852 ENDDO 1853 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1854 END SELECT 1855 CASE( 'mixed oce-ice' ) 1856 ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 1456 1857 DO jl=1,jpl 1457 ztmp 3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)1858 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1458 1859 ENDDO 1459 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )1860 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1460 1861 END SELECT 1461 CASE( 'mixed oce-ice' ) 1462 ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1463 DO jl=1,jpl 1464 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1465 ENDDO 1466 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1467 END SELECT 1862 ENDIF 1468 1863 IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1469 1864 IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info ) … … 1474 1869 ! ! ------------------------- ! 1475 1870 IF( ssnd(jps_albice)%laction ) THEN ! ice 1476 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1871 SELECT CASE( sn_snd_alb%cldes ) 1872 CASE( 'ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 1873 CASE( 'weighted ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1874 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 1875 END SELECT 1477 1876 CALL cpl_snd( jps_albice, isec, ztmp3, info ) 1478 1877 ENDIF … … 1487 1886 ! ! Ice fraction & Thickness ! 1488 1887 ! ! ------------------------- ! 1489 ! Send ice fraction field 1888 ! Send ice fraction field to atmosphere 1490 1889 IF( ssnd(jps_fice)%laction ) THEN 1491 1890 SELECT CASE( sn_snd_thick%clcat ) … … 1494 1893 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1495 1894 END SELECT 1496 CALL cpl_snd( jps_fice, isec, ztmp3, info ) 1895 IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info ) 1896 ENDIF 1897 1898 ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling) 1899 IF( ssnd(jps_fice2)%laction ) THEN 1900 ztmp3(:,:,1) = fr_i(:,:) 1901 IF( ssnd(jps_fice2)%laction ) CALL cpl_snd( jps_fice2, isec, ztmp3, info ) 1497 1902 ENDIF 1498 1903 … … 1515 1920 END SELECT 1516 1921 CASE( 'ice and snow' ) 1517 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 1518 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 1922 SELECT CASE( sn_snd_thick%clcat ) 1923 CASE( 'yes' ) 1924 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 1925 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 1926 CASE( 'no' ) 1927 WHERE( SUM( a_i, dim=3 ) /= 0. ) 1928 ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1929 ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1930 ELSEWHERE 1931 ztmp3(:,:,1) = 0. 1932 ztmp4(:,:,1) = 0. 1933 END WHERE 1934 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1935 END SELECT 1519 1936 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 1520 1937 END SELECT … … 1568 1985 ! i-1 i i 1569 1986 ! i i+1 (for I) 1570 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1571 CASE( 'oce only' ) ! C-grid ==> T 1572 DO jj = 2, jpjm1 1573 DO ji = fs_2, fs_jpim1 ! vector opt. 1574 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1575 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1576 END DO 1577 END DO 1578 CASE( 'weighted oce and ice' ) 1579 SELECT CASE ( cp_ice_msh ) 1580 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1987 IF( nn_components == jp_iam_opa ) THEN 1988 zotx1(:,:) = un(:,:,1) 1989 zoty1(:,:) = vn(:,:,1) 1990 ELSE 1991 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1992 CASE( 'oce only' ) ! C-grid ==> T 1581 1993 DO jj = 2, jpjm1 1582 1994 DO ji = fs_2, fs_jpim1 ! vector opt. 1583 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 1584 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 1585 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1586 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1995 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1996 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1587 1997 END DO 1588 1998 END DO 1589 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1590 DO jj = 2, jpjm1 1591 DO ji = 2, jpim1 ! NO vector opt. 1592 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 1593 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1594 zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1595 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1596 zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1597 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1999 CASE( 'weighted oce and ice' ) 2000 SELECT CASE ( cp_ice_msh ) 2001 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 2002 DO jj = 2, jpjm1 2003 DO ji = fs_2, fs_jpim1 ! vector opt. 2004 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 2005 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 2006 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2007 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2008 END DO 1598 2009 END DO 1599 END DO1600 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T1601 DO jj = 2, jpjm11602 DO ji = 2, jpim1 ! NO vector opt.1603 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj,1) ) * zfr_l(ji,jj)1604 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj)1605 zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) &1606 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)1607 zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) &1608 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)2010 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 2011 DO jj = 2, jpjm1 2012 DO ji = 2, jpim1 ! NO vector opt. 2013 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 2014 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 2015 zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 2016 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 2017 zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 2018 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 2019 END DO 1609 2020 END DO 1610 END DO 2021 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 2022 DO jj = 2, jpjm1 2023 DO ji = 2, jpim1 ! NO vector opt. 2024 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 2025 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 2026 zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 2027 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 2028 zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 2029 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 2030 END DO 2031 END DO 2032 END SELECT 2033 CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. ) 2034 CASE( 'mixed oce-ice' ) 2035 SELECT CASE ( cp_ice_msh ) 2036 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 2037 DO jj = 2, jpjm1 2038 DO ji = fs_2, fs_jpim1 ! vector opt. 2039 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 2040 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2041 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 2042 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2043 END DO 2044 END DO 2045 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 2046 DO jj = 2, jpjm1 2047 DO ji = 2, jpim1 ! NO vector opt. 2048 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 2049 & + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 2050 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 2051 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 2052 & + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 2053 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 2054 END DO 2055 END DO 2056 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 2057 DO jj = 2, jpjm1 2058 DO ji = 2, jpim1 ! NO vector opt. 2059 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 2060 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 2061 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 2062 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 2063 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 2064 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 2065 END DO 2066 END DO 2067 END SELECT 1611 2068 END SELECT 1612 CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. ) 1613 CASE( 'mixed oce-ice' ) 1614 SELECT CASE ( cp_ice_msh ) 1615 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1616 DO jj = 2, jpjm1 1617 DO ji = fs_2, fs_jpim1 ! vector opt. 1618 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 1619 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1620 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 1621 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1622 END DO 1623 END DO 1624 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1625 DO jj = 2, jpjm1 1626 DO ji = 2, jpim1 ! NO vector opt. 1627 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1628 & + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1629 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1630 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1631 & + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1632 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1633 END DO 1634 END DO 1635 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1636 DO jj = 2, jpjm1 1637 DO ji = 2, jpim1 ! NO vector opt. 1638 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1639 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1640 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1641 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1642 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1643 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1644 END DO 1645 END DO 1646 END SELECT 1647 END SELECT 1648 CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 2069 CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 2070 ! 2071 ENDIF 1649 2072 ! 1650 2073 ! … … 1686 2109 ENDIF 1687 2110 ! 2111 ! 2112 ! Fields sent by OPA to SAS when doing OPA<->SAS coupling 2113 ! ! SSH 2114 IF( ssnd(jps_ssh )%laction ) THEN 2115 ! ! removed inverse barometer ssh when Patm 2116 ! forcing is used (for sea-ice dynamics) 2117 IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 2118 ELSE ; ztmp1(:,:) = sshn(:,:) 2119 ENDIF 2120 CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info ) 2121 2122 ENDIF 2123 ! ! SSS 2124 IF( ssnd(jps_soce )%laction ) THEN 2125 CALL cpl_snd( jps_soce , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info ) 2126 ENDIF 2127 ! ! first T level thickness 2128 IF( ssnd(jps_e3t1st )%laction ) THEN 2129 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1) , (/jpi,jpj,1/) ), info ) 2130 ENDIF 2131 ! ! Qsr fraction 2132 IF( ssnd(jps_fraqsr)%laction ) THEN 2133 CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info ) 2134 ENDIF 2135 ! 2136 ! Fields sent by SAS to OPA when OASIS coupling 2137 ! ! Solar heat flux 2138 IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info ) 2139 IF( ssnd(jps_qnsoce)%laction ) CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info ) 2140 IF( ssnd(jps_oemp )%laction ) CALL cpl_snd( jps_oemp , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info ) 2141 IF( ssnd(jps_sflx )%laction ) CALL cpl_snd( jps_sflx , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info ) 2142 IF( ssnd(jps_otx1 )%laction ) CALL cpl_snd( jps_otx1 , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info ) 2143 IF( ssnd(jps_oty1 )%laction ) CALL cpl_snd( jps_oty1 , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info ) 2144 IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) 2145 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 2146 1688 2147 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 1689 2148 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )
Note: See TracChangeset
for help on using the changeset viewer.
