Changeset 12377 for NEMO/trunk/src/OCE/SBC/sbccpl.F90
- Timestamp:
- 2020-02-12T15:39:06+01:00 (4 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/SBC/sbccpl.F90 (modified) (56 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEAD ext/AGRIF5 ^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL
-
- Property svn:externals
-
NEMO/trunk/src/OCE/SBC/sbccpl.F90
r12288 r12377 27 27 USE sbcwave ! surface boundary condition: waves 28 28 USE phycst ! physical constants 29 USE isf_oce , ONLY : l_isfoasis, fwfisf_oasis ! ice shelf boundary condition 29 30 #if defined key_si3 30 31 USE ice ! ice variables … … 32 33 USE cpl_oasis3 ! OASIS3 coupling 33 34 USE geo2ocean ! 34 USE oce , ONLY : ts n, un, vn, sshn, ub, vb, sshb, fraqsr_1lev35 USE oce , ONLY : ts, uu, vv, ssh, fraqsr_1lev 35 36 USE ocealb ! 36 37 USE eosbn2 ! 37 38 USE sbcrnf , ONLY : l_rnfcpl 38 USE sbcisf , ONLY : l_isfcpl39 39 #if defined key_cice 40 40 USE ice_domain_size, only: ncat … … 198 198 199 199 !! Substitution 200 # include " vectopt_loop_substitute.h90"200 # include "do_loop_substitute.h90" 201 201 !!---------------------------------------------------------------------- 202 202 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 264 264 ! ================================ ! 265 265 ! 266 REWIND( numnam_ref ) ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling267 266 READ ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901) 268 267 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist' ) 269 268 ! 270 REWIND( numnam_cfg ) ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling271 269 READ ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 ) 272 270 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist' ) … … 453 451 CASE( 'conservative' ) 454 452 srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 455 IF 453 IF( k_ice <= 1 ) srcv(jpr_ievp)%laction = .FALSE. 456 454 CASE( 'oce and ice' ) ; srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE. 457 455 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) … … 474 472 srcv(jpr_icb)%clname = 'OIceberg' ; IF( TRIM( sn_rcv_icb%cldes) == 'coupled' ) srcv(jpr_icb)%laction = .TRUE. 475 473 476 IF( srcv(jpr_isf)%laction .AND. ln_isf) THEN477 l_isf cpl = .TRUE. ! -> no need to read isf in sbcisf474 IF( srcv(jpr_isf)%laction ) THEN 475 l_isfoasis = .TRUE. ! -> isf fwf comes from oasis 478 476 IF(lwp) WRITE(numout,*) 479 477 IF(lwp) WRITE(numout,*) ' iceshelf received from oasis ' 478 CALL ctl_stop('STOP','not coded') 480 479 ENDIF 481 480 ! … … 533 532 ! ! ------------------------- ! 534 533 srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE. 535 lhftau = srcv(jpr_taum)%laction536 534 ! 537 535 ! ! ------------------------- ! … … 558 556 srcv(jpr_botm )%clname = 'OBotMlt' 559 557 IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 560 IF 558 IF( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 561 559 srcv(jpr_topm:jpr_botm)%nct = nn_cats_cpl 562 560 ELSE … … 569 567 ! ! ------------------------- ! 570 568 srcv(jpr_ts_ice)%clname = 'OTsfIce' ! needed by Met Office 571 IF 572 IF 573 IF 569 IF( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' ) srcv(jpr_ts_ice)%laction = .TRUE. 570 IF( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' ) srcv(jpr_ts_ice)%nct = nn_cats_cpl 571 IF( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = nn_cats_cpl 574 572 575 573 #if defined key_si3 … … 699 697 ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere 700 698 DO jn = 1, jprcv 701 IF 699 IF( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 702 700 END DO 703 701 ! … … 726 724 ! =================================================== ! 727 725 DO jn = 1, jprcv 728 IF 726 IF( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 729 727 END DO 730 728 ! Allocate taum part of frcv which is used even when not received as coupling field 731 IF 729 IF( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 732 730 ! Allocate w10m part of frcv which is used even when not received as coupling field 733 IF 731 IF( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 734 732 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 735 IF 736 IF 733 IF( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 734 IF( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 737 735 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 738 736 IF( k_ice /= 0 ) THEN 739 IF 740 IF 741 END 737 IF( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 738 IF( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 739 ENDIF 742 740 743 741 ! ================================ ! … … 763 761 CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice' ) 764 762 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 765 IF 763 IF( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = nn_cats_cpl 766 764 CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE. 767 765 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) … … 783 781 ! 1. sending mixed oce-ice albedo or 784 782 ! 2. receiving mixed oce-ice solar radiation 785 IF 783 IF( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 786 784 CALL oce_alb( zaos, zacs ) 787 785 ! Due to lack of information on nebulosity : mean clear/overcast sky … … 802 800 ssnd(jps_fice1)%laction = .TRUE. ! First-order regridded ice concentration, to be used producing atmos-to-ice fluxes (Met Office requirement) 803 801 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 804 IF 805 IF 802 IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = nn_cats_cpl 803 IF( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl 806 804 ENDIF 807 805 808 IF 806 IF(TRIM( sn_snd_ifrac%cldes ) == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 809 807 810 808 SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) … … 812 810 CASE( 'ice and snow' ) 813 811 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 814 IF 812 IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 815 813 ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 816 814 ENDIF 817 815 CASE ( 'weighted ice and snow' ) 818 816 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 819 IF 817 IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 820 818 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 821 819 END SELECT … … 834 832 ssnd(jps_a_p)%laction = .TRUE. 835 833 ssnd(jps_ht_p)%laction = .TRUE. 836 IF 834 IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 837 835 ssnd(jps_a_p)%nct = nn_cats_cpl 838 836 ssnd(jps_ht_p)%nct = nn_cats_cpl 839 837 ELSE 840 IF 838 IF( nn_cats_cpl > 1 ) THEN 841 839 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 842 840 ENDIF … … 845 843 ssnd(jps_a_p)%laction = .TRUE. 846 844 ssnd(jps_ht_p)%laction = .TRUE. 847 IF 845 IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 848 846 ssnd(jps_a_p)%nct = nn_cats_cpl 849 847 ssnd(jps_ht_p)%nct = nn_cats_cpl … … 919 917 CASE ( 'ice only' ) 920 918 ssnd(jps_ttilyr)%laction = .TRUE. 921 IF 919 IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN 922 920 ssnd(jps_ttilyr)%nct = nn_cats_cpl 923 921 ELSE 924 IF 922 IF( nn_cats_cpl > 1 ) THEN 925 923 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' ) 926 924 ENDIF … … 928 926 CASE ( 'weighted ice' ) 929 927 ssnd(jps_ttilyr)%laction = .TRUE. 930 IF 928 IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl 931 929 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes ) 932 930 END SELECT … … 938 936 CASE ( 'ice only' ) 939 937 ssnd(jps_kice)%laction = .TRUE. 940 IF 938 IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 941 939 ssnd(jps_kice)%nct = nn_cats_cpl 942 940 ELSE 943 IF 941 IF( nn_cats_cpl > 1 ) THEN 944 942 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 945 943 ENDIF … … 947 945 CASE ( 'weighted ice' ) 948 946 ssnd(jps_kice)%laction = .TRUE. 949 IF 947 IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl 950 948 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes ) 951 949 END SELECT … … 1008 1006 ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 1009 1007 DO jn = 1, jpsnd 1010 IF 1008 IF( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 1011 1009 END DO 1012 1010 ! … … 1035 1033 CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 1036 1034 1037 IF 1035 IF(ln_usecplmask) THEN 1038 1036 xcplmask(:,:,:) = 0. 1039 1037 CALL iom_open( 'cplmask', inum ) … … 1049 1047 1050 1048 1051 SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )1049 SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice, Kbb, Kmm ) 1052 1050 !!---------------------------------------------------------------------- 1053 1051 !! *** ROUTINE sbc_cpl_rcv *** … … 1099 1097 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 1100 1098 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 1099 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean model time level indices 1101 1100 !! 1102 1101 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? … … 1166 1165 ! 1167 1166 IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN 1168 DO jj = 2, jpjm1 ! T ==> (U,V) 1169 DO ji = fs_2, fs_jpim1 ! vector opt. 1170 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 1171 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 1172 END DO 1173 END DO 1167 DO_2D_00_00 1168 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 1169 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 1170 END_2D 1174 1171 CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1., frcv(jpr_oty1)%z3(:,:,1), 'V', -1. ) 1175 1172 ENDIF … … 1192 1189 ! => need to be done only when otx1 was changed 1193 1190 IF( llnewtx ) THEN 1194 DO jj = 2, jpjm1 1195 DO ji = fs_2, fs_jpim1 ! vect. opt. 1196 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 1197 zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) 1198 frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 1199 END DO 1200 END DO 1191 DO_2D_00_00 1192 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 1193 zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) 1194 frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 1195 END_2D 1201 1196 CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1. ) 1202 1197 llnewtau = .TRUE. … … 1219 1214 IF( llnewtau ) THEN 1220 1215 zcoef = 1. / ( zrhoa * zcdrag ) 1221 DO jj = 1, jpj 1222 DO ji = 1, jpi 1223 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 1224 END DO 1225 END DO 1216 DO_2D_11_11 1217 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 1218 END_2D 1226 1219 ENDIF 1227 1220 ENDIF … … 1262 1255 1263 1256 IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) ! correct this later (read from restart if possible) 1264 END 1257 ENDIF 1265 1258 ! 1266 1259 IF( ln_sdw ) THEN ! Stokes Drift correction activated … … 1298 1291 IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction & 1299 1292 .OR. srcv(jpr_hsig)%laction .OR. srcv(jpr_wfreq)%laction) THEN 1300 CALL sbc_stokes( )1293 CALL sbc_stokes( Kmm ) 1301 1294 ENDIF 1302 1295 ENDIF … … 1350 1343 IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1351 1344 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1352 u b (:,:,1) = ssu_m(:,:)! will be used in icestp in the call of ice_forcing_tau1353 u n (:,:,1) = ssu_m(:,:)! will be used in sbc_cpl_snd if atmosphere coupling1345 uu(:,:,1,Kbb) = ssu_m(:,:) ! will be used in icestp in the call of ice_forcing_tau 1346 uu(:,:,1,Kmm) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1354 1347 CALL iom_put( 'ssu_m', ssu_m ) 1355 1348 ENDIF 1356 1349 IF( srcv(jpr_ocy1)%laction ) THEN 1357 1350 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1358 v b (:,:,1) = ssv_m(:,:)! will be used in icestp in the call of ice_forcing_tau1359 v n (:,:,1) = ssv_m(:,:)! will be used in sbc_cpl_snd if atmosphere coupling1351 vv(:,:,1,Kbb) = ssv_m(:,:) ! will be used in icestp in the call of ice_forcing_tau 1352 vv(:,:,1,Kmm) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1360 1353 CALL iom_put( 'ssv_m', ssv_m ) 1361 1354 ENDIF … … 1401 1394 rnf(:,:) = rnf(:,:) + fwficb(:,:) ! iceberg added to runfofs 1402 1395 ENDIF 1403 IF( srcv(jpr_isf)%laction ) fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting) 1396 ! 1397 ! ice shelf fwf 1398 IF( srcv(jpr_isf)%laction ) THEN 1399 fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting) 1400 END IF 1404 1401 1405 1402 IF( ln_mixcpl ) THEN ; emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) … … 1411 1408 ELSE IF( srcv(jpr_qnsmix)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1412 1409 ELSE ; zqns(:,:) = 0._wp 1413 END 1410 ENDIF 1414 1411 ! update qns over the free ocean with: 1415 1412 IF( nn_components /= jp_iam_opa ) THEN … … 1546 1543 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 1547 1544 CASE( 'F' ) 1548 DO jj = 2, jpjm1 ! F ==> (U,V) 1549 DO ji = fs_2, fs_jpim1 ! vector opt. 1550 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj-1,1) ) 1551 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) ) 1552 END DO 1553 END DO 1545 DO_2D_00_00 1546 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj-1,1) ) 1547 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) ) 1548 END_2D 1554 1549 CASE( 'T' ) 1555 DO jj = 2, jpjm1 ! T ==> (U,V) 1556 DO ji = fs_2, fs_jpim1 ! vector opt. 1557 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 1558 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1559 END DO 1560 END DO 1550 DO_2D_00_00 1551 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 1552 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1553 END_2D 1561 1554 CASE( 'I' ) 1562 DO jj = 2, jpjm1 ! I ==> (U,V) 1563 DO ji = 2, jpim1 ! NO vector opt. 1564 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) ) 1565 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji ,jj+1,1) ) 1566 END DO 1567 END DO 1555 DO_2D_00_00 1556 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) ) 1557 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji ,jj+1,1) ) 1558 END_2D 1568 1559 END SELECT 1569 1560 IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN … … 1683 1674 ! --- evaporation over ice (kg/m2/s) --- ! 1684 1675 DO jl=1,jpl 1685 IF 1676 IF(sn_rcv_emp%clcat == 'yes') THEN ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 1686 1677 ELSE ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 ) ; ENDIF 1687 1678 ENDDO … … 1704 1695 ENDIF 1705 1696 IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting) 1706 fwfisf (:,:) = - frcv(jpr_isf)%z3(:,:,1)1697 fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) 1707 1698 ENDIF 1708 1699 … … 1743 1734 ENDIF 1744 1735 IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting) 1745 fwfisf (:,:) = - frcv(jpr_isf)%z3(:,:,1)1736 fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) 1746 1737 ENDIF 1747 1738 ! … … 1765 1756 IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving 1766 1757 IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs 1767 CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow1768 CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation1769 IF ( iom_use('rain') )CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation1770 IF ( iom_use('snow_ao_cea') )CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average)1771 IF ( iom_use('snow_ai_cea') )CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average)1772 IF ( iom_use('rain_ao_cea') )CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:) ) ! liquid precipitation over ocean (cell average)1773 IF ( iom_use('subl_ai_cea') )CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average)1774 IF ( iom_use('evap_ao_cea') )CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) &1758 IF( iom_use('snowpre') ) CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1759 IF( iom_use('precip') ) CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation 1760 IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation 1761 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1762 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1763 IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:) ) ! liquid precipitation over ocean (cell average) 1764 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average) 1765 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & 1775 1766 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1776 1767 ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf … … 1783 1774 CASE( 'conservative' ) ! the required fields are directly provided 1784 1775 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1785 IF 1776 IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1786 1777 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1787 1778 ELSE … … 1792 1783 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1793 1784 zqns_tot(:,:) = ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1794 IF 1785 IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1795 1786 DO jl=1,jpl 1796 1787 zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) … … 1904 1895 #endif 1905 1896 ! outputs 1906 IF ( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving 1907 IF ( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * rLfus ) ! latent heat from icebergs melting 1908 IF ( iom_use( 'hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1909 IF ( iom_use( 'hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) & 1910 & * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from evap (cell average) 1911 IF ( iom_use( 'hflx_prec_cea') ) CALL iom_put('hflx_prec_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & ! heat flux from all precip (cell avg) 1912 & + ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) 1913 IF ( iom_use( 'hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) ) ! heat flux from snow (cell average) 1914 IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean) 1915 IF ( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) * zsnw(:,:) ) ! heat flux from snow (over ice) 1897 IF( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving 1898 IF( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * rLfus ) ! latent heat from icebergs melting 1899 IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1900 IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 1901 & * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from evap (cell average) 1902 IF( iom_use('hflx_prec_cea') ) CALL iom_put('hflx_prec_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) + & ! heat flux from all precip (cell avg) 1903 & ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) 1904 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) ) ! heat flux from snow (cell average) 1905 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1906 & * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean) 1907 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1908 & * zsnw(:,:) ) ! heat flux from snow (over ice) 1916 1909 ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. 1917 1910 ! … … 1923 1916 CASE( 'conservative' ) 1924 1917 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1925 IF 1918 IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1926 1919 zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 1927 1920 ELSE … … 1933 1926 CASE( 'oce and ice' ) 1934 1927 zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1935 IF 1928 IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1936 1929 DO jl = 1, jpl 1937 1930 zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) … … 1999 1992 ! ! ========================= ! 2000 1993 CASE ('coupled') 2001 IF 1994 IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 2002 1995 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 2003 1996 ELSE … … 2088 2081 2089 2082 2090 SUBROUTINE sbc_cpl_snd( kt )2083 SUBROUTINE sbc_cpl_snd( kt, Kbb, Kmm ) 2091 2084 !!---------------------------------------------------------------------- 2092 2085 !! *** ROUTINE sbc_cpl_snd *** … … 2098 2091 !!---------------------------------------------------------------------- 2099 2092 INTEGER, INTENT(in) :: kt 2093 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean model time level index 2100 2094 ! 2101 2095 INTEGER :: ji, jj, jl ! dummy loop indices … … 2114 2108 IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 2115 2109 2116 IF 2117 ztmp1(:,:) = ts n(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part2110 IF( nn_components == jp_iam_opa ) THEN 2111 ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 2118 2112 ELSE 2119 2113 ! we must send the surface potential temperature 2120 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( ts n(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )2121 ELSE ; ztmp1(:,:) = ts n(:,:,1,jp_tem)2114 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) ) 2115 ELSE ; ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) 2122 2116 ENDIF 2123 2117 ! … … 2147 2141 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 2148 2142 END SELECT 2149 CASE( 'oce and weighted ice') ; ztmp1(:,:) = ts n(:,:,1,jp_tem) + rt02143 CASE( 'oce and weighted ice') ; ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) + rt0 2150 2144 SELECT CASE( sn_snd_temp%clcat ) 2151 2145 CASE( 'yes' ) … … 2353 2347 ! ! CO2 flux from PISCES ! 2354 2348 ! ! ------------------------- ! 2355 IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) THEN 2356 ztmp1(:,:) = oce_co2(:,:) * 1000. ! conversion in molC/m2/s 2357 CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ) , info ) 2358 ENDIF 2349 IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) THEN 2350 ztmp1(:,:) = oce_co2(:,:) * 1000. ! conversion in molC/m2/s 2351 CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ) , info ) 2352 ENDIF 2359 2353 ! 2360 2354 ! ! ------------------------- ! … … 2371 2365 ! i i+1 (for I) 2372 2366 IF( nn_components == jp_iam_opa ) THEN 2373 zotx1(:,:) = u n(:,:,1)2374 zoty1(:,:) = v n(:,:,1)2367 zotx1(:,:) = uu(:,:,1,Kmm) 2368 zoty1(:,:) = vv(:,:,1,Kmm) 2375 2369 ELSE 2376 2370 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 2377 2371 CASE( 'oce only' ) ! C-grid ==> T 2378 DO jj = 2, jpjm1 2379 DO ji = fs_2, fs_jpim1 ! vector opt. 2380 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2381 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 2382 END DO 2383 END DO 2372 DO_2D_00_00 2373 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) 2374 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji ,jj-1,1,Kmm) ) 2375 END_2D 2384 2376 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2385 DO jj = 2, jpjm1 2386 DO ji = fs_2, fs_jpim1 ! vector opt. 2387 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 2388 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 2389 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2390 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2391 END DO 2392 END DO 2377 DO_2D_00_00 2378 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2379 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 2380 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2381 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2382 END_2D 2393 2383 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. ) 2394 2384 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2395 DO jj = 2, jpjm1 2396 DO ji = fs_2, fs_jpim1 ! vector opt. 2397 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 2398 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2399 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 2400 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2401 END DO 2402 END DO 2385 DO_2D_00_00 2386 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & 2387 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2388 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) & 2389 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2390 END_2D 2403 2391 END SELECT 2404 2392 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1., zoty1, ssnd(jps_ocy1)%clgrid, -1. ) … … 2459 2447 SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 2460 2448 CASE( 'oce only' ) ! C-grid ==> T 2461 DO jj = 2, jpjm1 2462 DO ji = fs_2, fs_jpim1 ! vector opt. 2463 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2464 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji , jj-1,1) ) 2465 END DO 2466 END DO 2449 DO_2D_00_00 2450 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) 2451 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) ) 2452 END_2D 2467 2453 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2468 DO jj = 2, jpjm1 2469 DO ji = fs_2, fs_jpim1 ! vector opt. 2470 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 2471 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 2472 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2473 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2474 END DO 2475 END DO 2454 DO_2D_00_00 2455 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2456 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 2457 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2458 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2459 END_2D 2476 2460 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. ) 2477 2461 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2478 DO jj = 2, jpjm1 2479 DO ji = fs_2, fs_jpim1 ! vector opt. 2480 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 2481 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2482 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 2483 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2484 END DO 2485 END DO 2462 DO_2D_00_00 2463 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & 2464 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2465 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) & 2466 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2467 END_2D 2486 2468 END SELECT 2487 2469 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1., zoty1, ssnd(jps_ocyw)%clgrid, -1. ) … … 2522 2504 IF( ssnd(jps_ficet)%laction ) THEN 2523 2505 CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info ) 2524 END 2506 ENDIF 2525 2507 ! ! ------------------------- ! 2526 2508 ! ! Water levels to waves ! … … 2529 2511 IF( ln_apr_dyn ) THEN 2530 2512 IF( kt /= nit000 ) THEN 2531 ztmp1(:,:) = ssh b(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )2513 ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 2532 2514 ELSE 2533 ztmp1(:,:) = ssh b(:,:)2515 ztmp1(:,:) = ssh(:,:,Kbb) 2534 2516 ENDIF 2535 2517 ELSE 2536 ztmp1(:,:) = ssh n(:,:)2518 ztmp1(:,:) = ssh(:,:,Kmm) 2537 2519 ENDIF 2538 2520 CALL cpl_snd( jps_wlev , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2539 END 2521 ENDIF 2540 2522 ! 2541 2523 ! Fields sent by OPA to SAS when doing OPA<->SAS coupling … … 2544 2526 ! ! removed inverse barometer ssh when Patm 2545 2527 ! forcing is used (for sea-ice dynamics) 2546 IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = ssh b(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )2547 ELSE ; ztmp1(:,:) = ssh n(:,:)2528 IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 2529 ELSE ; ztmp1(:,:) = ssh(:,:,Kmm) 2548 2530 ENDIF 2549 2531 CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info ) … … 2552 2534 ! ! SSS 2553 2535 IF( ssnd(jps_soce )%laction ) THEN 2554 CALL cpl_snd( jps_soce , isec, RESHAPE ( ts n(:,:,1,jp_sal), (/jpi,jpj,1/) ), info )2536 CALL cpl_snd( jps_soce , isec, RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) ), info ) 2555 2537 ENDIF 2556 2538 ! ! first T level thickness 2557 2539 IF( ssnd(jps_e3t1st )%laction ) THEN 2558 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t _n(:,:,1) , (/jpi,jpj,1/) ), info )2540 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(:,:,1,Kmm) , (/jpi,jpj,1/) ), info ) 2559 2541 ENDIF 2560 2542 ! ! Qsr fraction … … 2579 2561 ! ! ------------------------- ! 2580 2562 ! needed by Met Office 2581 CALL eos_fzp(ts n(:,:,1,jp_sal), sstfrz)2563 CALL eos_fzp(ts(:,:,1,jp_sal,Kmm), sstfrz) 2582 2564 ztmp1(:,:) = sstfrz(:,:) + rt0 2583 2565 IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info)
Note: See TracChangeset
for help on using the changeset viewer.
