- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/SBC/sbccpl.F90 (modified) (75 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/SBC/sbccpl.F90
r10617 r13463 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 … … 193 193 194 194 REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2] 195 REAL(wp) :: r1_grau ! = 1.e0 / (grav * r au0)195 REAL(wp) :: r1_grau ! = 1.e0 / (grav * rho0) 196 196 197 197 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) :: nrcvinfo ! OASIS info argument 198 198 199 199 !! Substitution 200 # include "vectopt_loop_substitute.h90" 200 # include "do_loop_substitute.h90" 201 # include "domzgr_substitute.h90" 201 202 !!---------------------------------------------------------------------- 202 203 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 264 265 ! ================================ ! 265 266 ! 266 REWIND( numnam_ref ) ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling267 267 READ ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901) 268 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp ) 269 ! 270 REWIND( numnam_cfg ) ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling 268 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist' ) 269 ! 271 270 READ ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 ) 272 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist' , lwp)271 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist' ) 273 272 IF(lwm) WRITE ( numond, namsbc_cpl ) 274 273 ! … … 366 365 ! 367 366 ! Vectors: change of sign at north fold ONLY if on the local grid 368 IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM(sn_rcv_tau%cldes ) == 'oce and ice') THEN ! avoid working with the atmospheric fields if they are not coupled 367 IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM( sn_rcv_tau%cldes ) == 'oce and ice' & 368 .OR. TRIM( sn_rcv_tau%cldes ) == 'mixed oce-ice' ) THEN ! avoid working with the atmospheric fields if they are not coupled 369 369 370 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 370 371 … … 453 454 CASE( 'conservative' ) 454 455 srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 455 IF 456 IF( k_ice <= 1 ) srcv(jpr_ievp)%laction = .FALSE. 456 457 CASE( 'oce and ice' ) ; srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE. 457 458 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) … … 474 475 srcv(jpr_icb)%clname = 'OIceberg' ; IF( TRIM( sn_rcv_icb%cldes) == 'coupled' ) srcv(jpr_icb)%laction = .TRUE. 475 476 476 IF( srcv(jpr_isf)%laction .AND. ln_isf) THEN477 l_isf cpl = .TRUE. ! -> no need to read isf in sbcisf477 IF( srcv(jpr_isf)%laction ) THEN 478 l_isfoasis = .TRUE. ! -> isf fwf comes from oasis 478 479 IF(lwp) WRITE(numout,*) 479 480 IF(lwp) WRITE(numout,*) ' iceshelf received from oasis ' 481 CALL ctl_stop('STOP','not coded') 480 482 ENDIF 481 483 ! … … 533 535 ! ! ------------------------- ! 534 536 srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE. 535 lhftau = srcv(jpr_taum)%laction536 537 ! 537 538 ! ! ------------------------- ! … … 558 559 srcv(jpr_botm )%clname = 'OBotMlt' 559 560 IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 560 IF 561 IF( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 561 562 srcv(jpr_topm:jpr_botm)%nct = nn_cats_cpl 562 563 ELSE … … 569 570 ! ! ------------------------- ! 570 571 srcv(jpr_ts_ice)%clname = 'OTsfIce' ! needed by Met Office 571 IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' ) srcv(jpr_ts_ice)%laction = .TRUE. 572 IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' ) srcv(jpr_ts_ice)%nct = nn_cats_cpl 573 IF ( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = nn_cats_cpl 574 572 IF( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' ) srcv(jpr_ts_ice)%laction = .TRUE. 573 IF( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' ) srcv(jpr_ts_ice)%nct = nn_cats_cpl 574 IF( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = nn_cats_cpl 575 576 #if defined key_si3 577 IF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN 578 IF( .NOT.srcv(jpr_ts_ice)%laction ) & 579 & CALL ctl_stop( 'sbc_cpl_init: srcv(jpr_ts_ice)%laction should be set to true when ln_cndflx=T' ) 580 ENDIF 581 #endif 575 582 ! ! ------------------------- ! 576 583 ! ! Wave breaking ! … … 691 698 ! Change first letter to couple with atmosphere if already coupled OPA 692 699 ! this is nedeed as each variable name used in the namcouple must be unique: 693 ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere700 ! for example O_Runoff received by OPA from SAS and therefore S_Runoff received by SAS from the Atmosphere 694 701 DO jn = 1, jprcv 695 IF 702 IF( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 696 703 END DO 697 704 ! … … 720 727 ! =================================================== ! 721 728 DO jn = 1, jprcv 722 IF 729 IF( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 723 730 END DO 724 731 ! Allocate taum part of frcv which is used even when not received as coupling field 725 IF 732 IF( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 726 733 ! Allocate w10m part of frcv which is used even when not received as coupling field 727 IF 734 IF( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 728 735 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 729 IF 730 IF 736 IF( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 737 IF( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 731 738 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 732 739 IF( k_ice /= 0 ) THEN 733 IF 734 IF 735 END 740 IF( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 741 IF( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 742 ENDIF 736 743 737 744 ! ================================ ! … … 757 764 CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice' ) 758 765 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 759 IF 766 IF( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = nn_cats_cpl 760 767 CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE. 761 768 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) … … 777 784 ! 1. sending mixed oce-ice albedo or 778 785 ! 2. receiving mixed oce-ice solar radiation 779 IF 786 IF( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 780 787 CALL oce_alb( zaos, zacs ) 781 788 ! Due to lack of information on nebulosity : mean clear/overcast sky … … 796 803 ssnd(jps_fice1)%laction = .TRUE. ! First-order regridded ice concentration, to be used producing atmos-to-ice fluxes (Met Office requirement) 797 804 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 798 IF 799 IF 805 IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = nn_cats_cpl 806 IF( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl 800 807 ENDIF 801 808 802 IF 809 IF(TRIM( sn_snd_ifrac%cldes ) == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 803 810 804 811 SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) … … 806 813 CASE( 'ice and snow' ) 807 814 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 808 IF 815 IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 809 816 ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 810 817 ENDIF 811 818 CASE ( 'weighted ice and snow' ) 812 819 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 813 IF 820 IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 814 821 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 815 822 END SELECT … … 828 835 ssnd(jps_a_p)%laction = .TRUE. 829 836 ssnd(jps_ht_p)%laction = .TRUE. 830 IF 837 IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 831 838 ssnd(jps_a_p)%nct = nn_cats_cpl 832 839 ssnd(jps_ht_p)%nct = nn_cats_cpl 833 840 ELSE 834 IF 841 IF( nn_cats_cpl > 1 ) THEN 835 842 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 836 843 ENDIF … … 839 846 ssnd(jps_a_p)%laction = .TRUE. 840 847 ssnd(jps_ht_p)%laction = .TRUE. 841 IF 848 IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 842 849 ssnd(jps_a_p)%nct = nn_cats_cpl 843 850 ssnd(jps_ht_p)%nct = nn_cats_cpl … … 862 869 ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN 863 870 CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' ) 864 ssnd(jps_ocx1:jps_ivz1)%clgrid = 'T' ! all oce and ice components on the same unique grid865 871 ENDIF 866 872 ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE. ! default: all are send … … 914 920 CASE ( 'ice only' ) 915 921 ssnd(jps_ttilyr)%laction = .TRUE. 916 IF 922 IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN 917 923 ssnd(jps_ttilyr)%nct = nn_cats_cpl 918 924 ELSE 919 IF 925 IF( nn_cats_cpl > 1 ) THEN 920 926 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' ) 921 927 ENDIF … … 923 929 CASE ( 'weighted ice' ) 924 930 ssnd(jps_ttilyr)%laction = .TRUE. 925 IF 931 IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl 926 932 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes ) 927 933 END SELECT … … 933 939 CASE ( 'ice only' ) 934 940 ssnd(jps_kice)%laction = .TRUE. 935 IF 941 IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 936 942 ssnd(jps_kice)%nct = nn_cats_cpl 937 943 ELSE 938 IF 944 IF( nn_cats_cpl > 1 ) THEN 939 945 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 940 946 ENDIF … … 942 948 CASE ( 'weighted ice' ) 943 949 ssnd(jps_kice)%laction = .TRUE. 944 IF 950 IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl 945 951 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes ) 946 952 END SELECT … … 1003 1009 ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 1004 1010 DO jn = 1, jpsnd 1005 IF 1011 IF( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 1006 1012 END DO 1007 1013 ! … … 1030 1036 CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 1031 1037 1032 IF 1038 IF(ln_usecplmask) THEN 1033 1039 xcplmask(:,:,:) = 0. 1034 1040 CALL iom_open( 'cplmask', inum ) 1035 CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1: nlci,1:nlcj,1:nn_cplmodel), &1036 & kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) )1041 CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:jpi,1:jpj,1:nn_cplmodel), & 1042 & kstart = (/ mig(1),mjg(1),1 /), kcount = (/ jpi,jpj,nn_cplmodel /) ) 1037 1043 CALL iom_close( inum ) 1038 1044 ELSE … … 1041 1047 xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 1042 1048 ! 1043 ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' )1044 IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 ) &1045 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )1046 IF( ln_dm2dc .AND. ln_cpl ) ncpl_qsr_freq = 86400 / ncpl_qsr_freq1047 !1048 1049 END SUBROUTINE sbc_cpl_init 1049 1050 1050 1051 1051 SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )1052 SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice, Kbb, Kmm ) 1052 1053 !!---------------------------------------------------------------------- 1053 1054 !! *** ROUTINE sbc_cpl_rcv *** … … 1099 1100 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 1100 1101 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 1102 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean model time level indices 1101 1103 !! 1102 1104 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? … … 1111 1113 !!---------------------------------------------------------------------- 1112 1114 ! 1115 IF( kt == nit000 ) THEN 1116 ! cannot be done in the init phase when we use agrif as cpl_freq requires that oasis_enddef is done 1117 ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' ) 1118 IF( ln_dm2dc .AND. ncpl_qsr_freq /= 86400 ) & 1119 & CALL ctl_stop( 'sbc_cpl_rcv: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 1120 1121 IF( ncpl_qsr_freq /= 0) ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top 1122 1123 ENDIF 1124 ! 1113 1125 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 1114 1126 ! … … 1116 1128 ! ! Receive all the atmos. fields (including ice information) 1117 1129 ! ! ======================================================= ! 1118 isec = ( kt - nit000 ) * NINT( r dt ) ! date of exchanges1130 isec = ( kt - nit000 ) * NINT( rn_Dt ) ! date of exchanges 1119 1131 DO jn = 1, jprcv ! received fields sent by the atmosphere 1120 1132 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) … … 1158 1170 ! 1159 1171 IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN 1160 DO jj = 2, jpjm1 ! T ==> (U,V) 1161 DO ji = fs_2, fs_jpim1 ! vector opt. 1162 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 1163 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 1164 END DO 1165 END DO 1166 CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1., frcv(jpr_oty1)%z3(:,:,1), 'V', -1. ) 1172 DO_2D( 0, 0, 0, 0 ) 1173 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 1174 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 1175 END_2D 1176 CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1.0_wp, frcv(jpr_oty1)%z3(:,:,1), 'V', -1.0_wp ) 1167 1177 ENDIF 1168 1178 llnewtx = .TRUE. … … 1184 1194 ! => need to be done only when otx1 was changed 1185 1195 IF( llnewtx ) THEN 1186 DO jj = 2, jpjm1 1187 DO ji = fs_2, fs_jpim1 ! vect. opt. 1188 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 1189 zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) 1190 frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 1191 END DO 1192 END DO 1193 CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1. ) 1196 DO_2D( 0, 0, 0, 0 ) 1197 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 1198 zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) 1199 frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 1200 END_2D 1201 CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1.0_wp ) 1194 1202 llnewtau = .TRUE. 1195 1203 ELSE … … 1211 1219 IF( llnewtau ) THEN 1212 1220 zcoef = 1. / ( zrhoa * zcdrag ) 1213 DO jj = 1, jpj 1214 DO ji = 1, jpi 1215 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 1216 END DO 1217 END DO 1221 DO_2D( 1, 1, 1, 1 ) 1222 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 1223 END_2D 1218 1224 ENDIF 1219 1225 ENDIF … … 1243 1249 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 1244 1250 ! 1245 ! ! ================== !1246 ! ! ice skin temp. !1247 ! ! ================== !1248 #if defined key_si31249 ! needed by Met Office1250 IF( srcv(jpr_ts_ice)%laction ) THEN1251 WHERE ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0 ) ; tsfc_ice(:,:,:) = 0.01252 ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. ) ; tsfc_ice(:,:,:) = -60.1253 ELSEWHERE ; tsfc_ice(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:)1254 END WHERE1255 ENDIF1256 #endif1257 1251 ! ! ========================= ! 1258 1252 ! ! Mean Sea Level Pressure ! (taum) … … 1261 1255 IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields 1262 1256 1263 r1_grau = 1.e0 / (grav * r au0) !* constant for optimization1257 r1_grau = 1.e0 / (grav * rho0) !* constant for optimization 1264 1258 ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau ! equivalent ssh (inverse barometer) 1265 1259 apr (:,:) = frcv(jpr_mslp)%z3(:,:,1) !atmospheric pressure 1266 1260 1267 1261 IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) ! correct this later (read from restart if possible) 1268 END 1262 ENDIF 1269 1263 ! 1270 1264 IF( ln_sdw ) THEN ! Stokes Drift correction activated … … 1302 1296 IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction & 1303 1297 .OR. srcv(jpr_hsig)%laction .OR. srcv(jpr_wfreq)%laction) THEN 1304 CALL sbc_stokes( )1298 CALL sbc_stokes( Kmm ) 1305 1299 ENDIF 1306 1300 ENDIF … … 1354 1348 IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1355 1349 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1356 u b (:,:,1) = ssu_m(:,:)! will be used in icestp in the call of ice_forcing_tau1357 u n (:,:,1) = ssu_m(:,:)! will be used in sbc_cpl_snd if atmosphere coupling1350 uu(:,:,1,Kbb) = ssu_m(:,:) ! will be used in icestp in the call of ice_forcing_tau 1351 uu(:,:,1,Kmm) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1358 1352 CALL iom_put( 'ssu_m', ssu_m ) 1359 1353 ENDIF 1360 1354 IF( srcv(jpr_ocy1)%laction ) THEN 1361 1355 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1362 v b (:,:,1) = ssv_m(:,:)! will be used in icestp in the call of ice_forcing_tau1363 v n (:,:,1) = ssv_m(:,:)! will be used in sbc_cpl_snd if atmosphere coupling1356 vv(:,:,1,Kbb) = ssv_m(:,:) ! will be used in icestp in the call of ice_forcing_tau 1357 vv(:,:,1,Kmm) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1364 1358 CALL iom_put( 'ssv_m', ssv_m ) 1365 1359 ENDIF … … 1405 1399 rnf(:,:) = rnf(:,:) + fwficb(:,:) ! iceberg added to runfofs 1406 1400 ENDIF 1407 IF( srcv(jpr_isf)%laction ) fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting) 1401 ! 1402 ! ice shelf fwf 1403 IF( srcv(jpr_isf)%laction ) THEN 1404 fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting) 1405 END IF 1408 1406 1409 1407 IF( ln_mixcpl ) THEN ; emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) … … 1415 1413 ELSE IF( srcv(jpr_qnsmix)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1416 1414 ELSE ; zqns(:,:) = 0._wp 1417 END 1415 ENDIF 1418 1416 ! update qns over the free ocean with: 1419 1417 IF( nn_components /= jp_iam_opa ) THEN … … 1486 1484 INTEGER :: ji, jj ! dummy loop indices 1487 1485 INTEGER :: itx ! index of taux over ice 1486 REAL(wp) :: zztmp1, zztmp2 1488 1487 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty 1489 1488 !!---------------------------------------------------------------------- … … 1549 1548 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! (U,V) ==> (U,V) 1550 1549 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 1551 CASE( 'F' )1552 DO jj = 2, jpjm1 ! F ==> (U,V)1553 DO ji = fs_2, fs_jpim1 ! vector opt.1554 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj-1,1) )1555 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) )1556 END DO1557 END DO1558 1550 CASE( 'T' ) 1559 DO jj = 2, jpjm1 ! T ==> (U,V) 1560 DO ji = fs_2, fs_jpim1 ! vector opt. 1561 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 1562 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1563 END DO 1564 END DO 1565 CASE( 'I' ) 1566 DO jj = 2, jpjm1 ! I ==> (U,V) 1567 DO ji = 2, jpim1 ! NO vector opt. 1568 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) ) 1569 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji ,jj+1,1) ) 1570 END DO 1571 END DO 1551 DO_2D( 0, 0, 0, 0 ) 1552 ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology 1553 zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj ,1) ) 1554 zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji ,jj+1,1) ) 1555 p_taui(ji,jj) = zztmp1 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 1556 p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1557 END_2D 1558 CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. ) 1572 1559 END SELECT 1573 IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN1574 CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. )1575 ENDIF1576 1560 1577 1561 ENDIF … … 1630 1614 !! sprecip solid precipitation over the ocean 1631 1615 !!---------------------------------------------------------------------- 1632 REAL(wp), INTENT(in) , DIMENSION(:,:) :: picefr ! ice fraction [0 to 1]1633 ! !! ! optional arguments, used only in 'mixed oce-ice' case1634 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo1635 REAL(wp), INTENT(in) , DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius]1636 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin]1637 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: phs ! snow depth [m]1638 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: phi ! ice thickness [m]1616 REAL(wp), INTENT(in) , DIMENSION(:,:) :: picefr ! ice fraction [0 to 1] 1617 ! !! ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling 1618 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1619 REAL(wp), INTENT(in) , DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1620 REAL(wp), INTENT(inout), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] => inout for Met-Office 1621 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: phs ! snow depth [m] 1622 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: phi ! ice thickness [m] 1639 1623 ! 1640 1624 INTEGER :: ji, jj, jl ! dummy loop index … … 1643 1627 REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice 1644 1628 REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1645 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice !!gm , zfrqsr_tr_i1629 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu 1646 1630 !!---------------------------------------------------------------------- 1647 1631 ! … … 1687 1671 ! --- evaporation over ice (kg/m2/s) --- ! 1688 1672 DO jl=1,jpl 1689 IF 1673 IF(sn_rcv_emp%clcat == 'yes') THEN ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 1690 1674 ELSE ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 ) ; ENDIF 1691 1675 ENDDO … … 1708 1692 ENDIF 1709 1693 IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting) 1710 fwfisf (:,:) = - frcv(jpr_isf)%z3(:,:,1)1694 fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) 1711 1695 ENDIF 1712 1696 … … 1747 1731 ENDIF 1748 1732 IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting) 1749 fwfisf (:,:) = - frcv(jpr_isf)%z3(:,:,1)1733 fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) 1750 1734 ENDIF 1751 1735 ! … … 1774 1758 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1775 1759 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1760 IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:) ) ! liquid precipitation over ocean (cell average) 1776 1761 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) 1777 1762 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & … … 1786 1771 CASE( 'conservative' ) ! the required fields are directly provided 1787 1772 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1788 IF 1773 IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1789 1774 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1790 1775 ELSE … … 1795 1780 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1796 1781 zqns_tot(:,:) = ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1797 IF 1782 IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1798 1783 DO jl=1,jpl 1799 1784 zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) … … 1801 1786 ENDDO 1802 1787 ELSE 1803 qns_tot(:,:) =qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1788 zqns_tot(:,:) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1804 1789 DO jl = 1, jpl 1805 zqns_tot(:,: ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1806 1790 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1807 1791 END DO … … 1810 1794 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1811 1795 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1812 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1813 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * ziceld(:,:) & 1814 & + pist(:,:,1) * picefr(:,:) ) ) 1796 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1797 DO jl = 1, jpl 1798 zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:,jl) & 1799 & + frcv(jpr_dqnsdt)%z3(:,:,jl) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:) & 1800 & + pist(:,:,jl) * picefr(:,:) ) ) 1801 END DO 1802 ELSE 1803 DO jl = 1, jpl 1804 zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:, 1) & 1805 & + frcv(jpr_dqnsdt)%z3(:,:, 1) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:) & 1806 & + pist(:,:,jl) * picefr(:,:) ) ) 1807 END DO 1808 ENDIF 1815 1809 END SELECT 1816 1810 ! … … 1897 1891 #endif 1898 1892 ! outputs 1899 IF 1900 IF 1901 IF 1902 IF 1893 IF( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving 1894 IF( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * rLfus ) ! latent heat from icebergs melting 1895 IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1896 IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 1903 1897 & * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from evap (cell average) 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 ) & 1898 IF( iom_use('hflx_prec_cea') ) CALL iom_put('hflx_prec_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) + & ! heat flux from all precip (cell avg) 1899 & ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) 1900 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) ) ! heat flux from snow (cell average) 1901 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1906 1902 & * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean) 1907 IF 1903 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1908 1904 & * zsnw(:,:) ) ! heat flux from snow (over ice) 1909 1905 ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. … … 1916 1912 CASE( 'conservative' ) 1917 1913 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1918 IF 1914 IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1919 1915 zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 1920 1916 ELSE … … 1924 1920 END DO 1925 1921 ENDIF 1926 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1927 zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)1928 1922 CASE( 'oce and ice' ) 1929 1923 zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1930 IF 1924 IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1931 1925 DO jl = 1, jpl 1932 1926 zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) … … 1934 1928 END DO 1935 1929 ELSE 1936 qsr_tot(:,: ) =qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1930 zqsr_tot(:,:) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1937 1931 DO jl = 1, jpl 1938 zqsr_tot(:,: ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1939 1932 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1940 1933 END DO … … 1945 1938 ! Create solar heat flux over ice using incoming solar heat flux and albedos 1946 1939 ! ( see OASIS3 user guide, 5th edition, p39 ) 1947 zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1948 & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & 1949 & + palbi (:,:,1) * picefr(:,:) ) ) 1940 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1941 DO jl = 1, jpl 1942 zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:,jl) * ( 1.- palbi(:,:,jl) ) & 1943 & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & 1944 & + palbi (:,:,jl) * picefr(:,:) ) ) 1945 END DO 1946 ELSE 1947 DO jl = 1, jpl 1948 zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:, 1) * ( 1.- palbi(:,:,jl) ) & 1949 & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & 1950 & + palbi (:,:,jl) * picefr(:,:) ) ) 1951 END DO 1952 ENDIF 1950 1953 CASE( 'none' ) ! Not available as for now: needs additional coding 1951 1954 ! ! since fields received, here zqsr_tot, are not defined with none option … … 1984 1987 ! ! ========================= ! 1985 1988 CASE ('coupled') 1986 IF 1989 IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 1987 1990 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 1988 1991 ELSE … … 2007 2010 ! ! ========================= ! 2008 2011 CASE ('coupled') 2009 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 2010 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 2012 IF( ln_mixcpl ) THEN 2013 DO jl=1,jpl 2014 qml_ice(:,:,jl) = qml_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_topm)%z3(:,:,jl) * zmsk(:,:) 2015 qcn_ice(:,:,jl) = qcn_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_botm)%z3(:,:,jl) * zmsk(:,:) 2016 ENDDO 2017 ELSE 2018 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 2019 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 2020 ENDIF 2011 2021 END SELECT 2012 !2013 2022 ! ! ========================= ! 2014 2023 ! ! Transmitted Qsr ! [W/m2] … … 2017 2026 ! 2018 2027 ! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 2019 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission parameter(Grenfell Maykut 77)2028 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission when hi>10cm (Grenfell Maykut 77) 2020 2029 ! 2021 qtr_ice_top(:,:,:) = ztri * qsr_ice(:,:,:) 2022 WHERE( phs(:,:,:) >= 0.0_wp ) qtr_ice_top(:,:,:) = 0._wp ! snow fully opaque 2023 WHERE( phi(:,:,:) <= 0.1_wp ) qtr_ice_top(:,:,:) = qsr_ice(:,:,:) ! thin ice transmits all solar radiation 2030 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 2031 zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( ztri + ( 1._wp - ztri ) * ( 1._wp - phi(:,:,:) * 10._wp ) ) 2032 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (ztri) when hi>10cm 2033 zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ztri 2034 ELSEWHERE ! zero when hs>0 2035 zqtr_ice_top(:,:,:) = 0._wp 2036 END WHERE 2024 2037 ! 2025 2038 ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==! … … 2027 2040 ! ! ===> here we must receive the qtr_ice_top array from the coupler 2028 2041 ! for now just assume zero (fully opaque ice) 2029 qtr_ice_top(:,:,:) = 0._wp 2042 zqtr_ice_top(:,:,:) = 0._wp 2043 ! 2044 ENDIF 2045 ! 2046 IF( ln_mixcpl ) THEN 2047 DO jl=1,jpl 2048 qtr_ice_top(:,:,jl) = qtr_ice_top(:,:,jl) * xcplmask(:,:,0) + zqtr_ice_top(:,:,jl) * zmsk(:,:) 2049 ENDDO 2050 ELSE 2051 qtr_ice_top(:,:,:) = zqtr_ice_top(:,:,:) 2052 ENDIF 2053 ! ! ================== ! 2054 ! ! ice skin temp. ! 2055 ! ! ================== ! 2056 ! needed by Met Office 2057 IF( srcv(jpr_ts_ice)%laction ) THEN 2058 WHERE ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0 ) ; ztsu(:,:,:) = 0. + rt0 2059 ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. ) ; ztsu(:,:,:) = -60. + rt0 2060 ELSEWHERE ; ztsu(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:) + rt0 2061 END WHERE 2062 ! 2063 IF( ln_mixcpl ) THEN 2064 DO jl=1,jpl 2065 pist(:,:,jl) = pist(:,:,jl) * xcplmask(:,:,0) + ztsu(:,:,jl) * zmsk(:,:) 2066 ENDDO 2067 ELSE 2068 pist(:,:,:) = ztsu(:,:,:) 2069 ENDIF 2030 2070 ! 2031 2071 ENDIF … … 2036 2076 2037 2077 2038 SUBROUTINE sbc_cpl_snd( kt )2078 SUBROUTINE sbc_cpl_snd( kt, Kbb, Kmm ) 2039 2079 !!---------------------------------------------------------------------- 2040 2080 !! *** ROUTINE sbc_cpl_snd *** … … 2046 2086 !!---------------------------------------------------------------------- 2047 2087 INTEGER, INTENT(in) :: kt 2088 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean model time level index 2048 2089 ! 2049 2090 INTEGER :: ji, jj, jl ! dummy loop indices … … 2054 2095 !!---------------------------------------------------------------------- 2055 2096 ! 2056 isec = ( kt - nit000 ) * NINT( r dt ) ! date of exchanges2097 isec = ( kt - nit000 ) * NINT( rn_Dt ) ! date of exchanges 2057 2098 2058 2099 zfr_l(:,:) = 1.- fr_i(:,:) … … 2062 2103 IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 2063 2104 2064 IF 2065 ztmp1(:,:) = ts n(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part2105 IF( nn_components == jp_iam_opa ) THEN 2106 ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 2066 2107 ELSE 2067 2108 ! we must send the surface potential temperature 2068 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( ts n(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )2069 ELSE ; ztmp1(:,:) = ts n(:,:,1,jp_tem)2109 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) ) 2110 ELSE ; ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) 2070 2111 ENDIF 2071 2112 ! … … 2095 2136 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 2096 2137 END SELECT 2097 CASE( 'oce and weighted ice') ; ztmp1(:,:) = ts n(:,:,1,jp_tem) + rt02138 CASE( 'oce and weighted ice') ; ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) + rt0 2098 2139 SELECT CASE( sn_snd_temp%clcat ) 2099 2140 CASE( 'yes' ) … … 2190 2231 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 2191 2232 END SELECT 2192 IF( ssnd(jps_fice)%laction )CALL cpl_snd( jps_fice, isec, ztmp3, info )2233 CALL cpl_snd( jps_fice, isec, ztmp3, info ) 2193 2234 ENDIF 2194 2235 … … 2250 2291 ! ! Ice melt ponds ! 2251 2292 ! ! ------------------------- ! 2252 ! needed by Met Office 2293 ! needed by Met Office: 1) fraction of ponded ice 2) local/actual pond depth 2253 2294 IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 2254 2295 SELECT CASE( sn_snd_mpnd%cldes) … … 2256 2297 SELECT CASE( sn_snd_mpnd%clcat ) 2257 2298 CASE( 'yes' ) 2258 ztmp3(:,:,1:jpl) = a_ip (:,:,1:jpl)2259 ztmp4(:,:,1:jpl) = v_ip(:,:,1:jpl)2299 ztmp3(:,:,1:jpl) = a_ip_frac(:,:,1:jpl) 2300 ztmp4(:,:,1:jpl) = h_ip(:,:,1:jpl) 2260 2301 CASE( 'no' ) 2261 2302 ztmp3(:,:,:) = 0.0 2262 2303 ztmp4(:,:,:) = 0.0 2263 2304 DO jl=1,jpl 2264 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip (:,:,jpl)2265 ztmp4(:,:,1) = ztmp4(:,:,1) + v_ip(:,:,jpl)2305 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 2306 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 2266 2307 ENDDO 2267 2308 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' ) … … 2301 2342 ! ! CO2 flux from PISCES ! 2302 2343 ! ! ------------------------- ! 2303 IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 2344 IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) THEN 2345 ztmp1(:,:) = oce_co2(:,:) * 1000. ! conversion in molC/m2/s 2346 CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ) , info ) 2347 ENDIF 2304 2348 ! 2305 2349 ! ! ------------------------- ! … … 2316 2360 ! i i+1 (for I) 2317 2361 IF( nn_components == jp_iam_opa ) THEN 2318 zotx1(:,:) = u n(:,:,1)2319 zoty1(:,:) = v n(:,:,1)2362 zotx1(:,:) = uu(:,:,1,Kmm) 2363 zoty1(:,:) = vv(:,:,1,Kmm) 2320 2364 ELSE 2321 2365 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 2322 2366 CASE( 'oce only' ) ! C-grid ==> T 2323 DO jj = 2, jpjm1 2324 DO ji = fs_2, fs_jpim1 ! vector opt. 2325 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2326 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 2327 END DO 2328 END DO 2367 DO_2D( 0, 0, 0, 0 ) 2368 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) 2369 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji ,jj-1,1,Kmm) ) 2370 END_2D 2329 2371 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2330 DO jj = 2, jpjm1 2331 DO ji = fs_2, fs_jpim1 ! vector opt. 2332 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 2333 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 2334 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2335 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2336 END DO 2337 END DO 2338 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. ) 2372 DO_2D( 0, 0, 0, 0 ) 2373 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2374 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 2375 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2376 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2377 END_2D 2378 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2339 2379 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2340 DO jj = 2, jpjm1 2341 DO ji = fs_2, fs_jpim1 ! vector opt. 2342 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 2343 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2344 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 2345 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2346 END DO 2347 END DO 2380 DO_2D( 0, 0, 0, 0 ) 2381 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & 2382 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2383 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) & 2384 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2385 END_2D 2348 2386 END SELECT 2349 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1. , zoty1, ssnd(jps_ocy1)%clgrid, -1.)2387 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp ) 2350 2388 ! 2351 2389 ENDIF … … 2404 2442 SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 2405 2443 CASE( 'oce only' ) ! C-grid ==> T 2406 DO jj = 2, jpjm1 2407 DO ji = fs_2, fs_jpim1 ! vector opt. 2408 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2409 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji , jj-1,1) ) 2410 END DO 2411 END DO 2444 DO_2D( 0, 0, 0, 0 ) 2445 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) 2446 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) ) 2447 END_2D 2412 2448 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2413 DO jj = 2, jpjm1 2414 DO ji = fs_2, fs_jpim1 ! vector opt. 2415 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 2416 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 2417 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2418 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2419 END DO 2420 END DO 2421 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. ) 2449 DO_2D( 0, 0, 0, 0 ) 2450 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2451 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 2452 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2453 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2454 END_2D 2455 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2422 2456 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2423 DO jj = 2, jpjm1 2424 DO ji = fs_2, fs_jpim1 ! vector opt. 2425 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 2426 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2427 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 2428 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2429 END DO 2430 END DO 2457 DO_2D( 0, 0, 0, 0 ) 2458 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & 2459 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2460 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) & 2461 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2462 END_2D 2431 2463 END SELECT 2432 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1. , zoty1, ssnd(jps_ocyw)%clgrid, -1.)2464 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp ) 2433 2465 ! 2434 2466 ! … … 2467 2499 IF( ssnd(jps_ficet)%laction ) THEN 2468 2500 CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info ) 2469 END 2501 ENDIF 2470 2502 ! ! ------------------------- ! 2471 2503 ! ! Water levels to waves ! … … 2474 2506 IF( ln_apr_dyn ) THEN 2475 2507 IF( kt /= nit000 ) THEN 2476 ztmp1(:,:) = ssh b(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )2508 ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 2477 2509 ELSE 2478 ztmp1(:,:) = ssh b(:,:)2510 ztmp1(:,:) = ssh(:,:,Kbb) 2479 2511 ENDIF 2480 2512 ELSE 2481 ztmp1(:,:) = ssh n(:,:)2513 ztmp1(:,:) = ssh(:,:,Kmm) 2482 2514 ENDIF 2483 2515 CALL cpl_snd( jps_wlev , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2484 END 2516 ENDIF 2485 2517 ! 2486 2518 ! Fields sent by OPA to SAS when doing OPA<->SAS coupling … … 2489 2521 ! ! removed inverse barometer ssh when Patm 2490 2522 ! forcing is used (for sea-ice dynamics) 2491 IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = ssh b(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )2492 ELSE ; ztmp1(:,:) = ssh n(:,:)2523 IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 2524 ELSE ; ztmp1(:,:) = ssh(:,:,Kmm) 2493 2525 ENDIF 2494 2526 CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info ) … … 2497 2529 ! ! SSS 2498 2530 IF( ssnd(jps_soce )%laction ) THEN 2499 CALL cpl_snd( jps_soce , isec, RESHAPE ( ts n(:,:,1,jp_sal), (/jpi,jpj,1/) ), info )2531 CALL cpl_snd( jps_soce , isec, RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) ), info ) 2500 2532 ENDIF 2501 2533 ! ! first T level thickness 2502 2534 IF( ssnd(jps_e3t1st )%laction ) THEN 2503 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t _n(:,:,1) , (/jpi,jpj,1/) ), info )2535 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(:,:,1,Kmm) , (/jpi,jpj,1/) ), info ) 2504 2536 ENDIF 2505 2537 ! ! Qsr fraction … … 2524 2556 ! ! ------------------------- ! 2525 2557 ! needed by Met Office 2526 CALL eos_fzp(ts n(:,:,1,jp_sal), sstfrz)2558 CALL eos_fzp(ts(:,:,1,jp_sal,Kmm), sstfrz) 2527 2559 ztmp1(:,:) = sstfrz(:,:) + rt0 2528 2560 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.
