- Timestamp:
- 2011-09-09T15:33:04+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r2817 r2832 93 93 INTEGER, PARAMETER :: jpr_taum = 30 ! wind stress module 94 94 INTEGER, PARAMETER :: jpr_co2 = 31 95 INTEGER, PARAMETER :: jprcv = 31 ! total number of fields received 95 INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn 96 INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn 97 INTEGER, PARAMETER :: jprcv = 33 ! total number of fields received 96 98 97 99 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction … … 137 139 138 140 #if ! defined key_lim2 && ! defined key_lim3 139 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj140 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice, alb_ice ! (jpi,jpj,jpl)141 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice,fr1_i0,fr2_i0, emp_ice ! jpi, jpj 142 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice, alb_ice, qns_ice, dqns_ice ! (jpi,jpj,jpl) 141 143 #endif 142 144 … … 145 147 #elif ! defined key_lim2 && ! defined key_lim3 146 148 INTEGER, PARAMETER :: jpl = 1 149 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice 147 150 #endif 148 151 … … 153 156 #if ! defined key_lim3 154 157 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i, ht_s 158 #endif 159 160 #if ! defined key_cice 161 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt, botmelt 155 162 #endif 156 163 … … 178 185 ! quick patch to be able to run the coupled model without sea-ice... 179 186 ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , & 180 v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1) , STAT=ierr(2) ) 187 v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1), & 188 emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , STAT=ierr(2) ) 181 189 #endif 182 190 … … 216 224 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 217 225 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 218 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_ co2226 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx , sn_rcv_co2 219 227 !!--------------------------------------------------------------------- 220 228 … … 246 254 sn_rcv_rnf = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 247 255 sn_rcv_cal = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 256 sn_rcv_iceflx = FLD_C( 'none' , 'no' , '' , '' , '' ) 248 257 sn_rcv_co2 = FLD_C( 'none' , 'no' , '' , '' , '' ) 249 258 … … 268 277 WRITE(numout,*)' runoffs = ', TRIM(sn_rcv_rnf%cldes ), ' (', TRIM(sn_rcv_rnf%clcat ), ')' 269 278 WRITE(numout,*)' calving = ', TRIM(sn_rcv_cal%cldes ), ' (', TRIM(sn_rcv_cal%clcat ), ')' 279 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 270 280 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 271 WRITE(numout,*)' sent fields (mu tiple ice categogies)'281 WRITE(numout,*)' sent fields (multiple ice categories)' 272 282 WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')' 273 283 WRITE(numout,*)' albedo = ', TRIM(sn_snd_alb%cldes ), ' (', TRIM(sn_snd_alb%clcat ), ')' … … 398 408 ! ! ------------------------- ! 399 409 srcv(jpr_rnf )%clname = 'O_Runoff' ; IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 410 ! This isn't right - really just want ln_rnf_emp changed 400 411 ! IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' ) THEN ; ln_rnf = .TRUE. 401 412 ! ELSE ; ln_rnf = .FALSE. … … 416 427 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' ) 417 428 END SELECT 418 429 IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 430 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 419 431 ! ! ------------------------- ! 420 432 ! ! solar radiation ! Qsr … … 430 442 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' ) 431 443 END SELECT 432 444 IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 445 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 433 446 ! ! ------------------------- ! 434 447 ! ! non solar sensitivity ! d(Qns)/d(T) … … 467 480 ! ! ------------------------- ! 468 481 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 469 482 ! ! ------------------------- ! 483 ! ! topmelt and botmelt ! 484 ! ! ------------------------- ! 485 srcv(jpr_topm )%clname = 'OTopMlt' 486 srcv(jpr_botm )%clname = 'OBotMlt' 487 IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 488 IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 489 srcv(jpr_topm:jpr_botm)%nct = jpl 490 ELSE 491 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' ) 492 ENDIF 493 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 494 ENDIF 495 496 ! Allocate all parts of frcv used for received fields 470 497 DO jn = 1, jprcv 471 ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )498 IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 472 499 END DO 500 ! Allocate taum part of frcv which is used even when not received as coupling field 501 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jn)%nct) ) 473 502 474 503 ! ================================ ! … … 533 562 CASE ( 'ice and snow' ) 534 563 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 535 ssnd(jps_hice:jps_hsnw)%nct = jpl 564 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 565 ssnd(jps_hice:jps_hsnw)%nct = jpl 566 ELSE 567 IF ( jpl > 1 ) THEN 568 CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' ) 569 ENDIF 570 ENDIF 536 571 CASE ( 'weighted ice and snow' ) 537 572 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. … … 756 791 !CDIR NOVERRCHK 757 792 DO ji = 1, jpi 758 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_w10m)%z3(ji,jj,1) * zcoef )793 wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 759 794 END DO 760 795 END DO 761 796 ENDIF 797 ELSE 798 IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 762 799 ENDIF 763 800 … … 1045 1082 1046 1083 1047 SUBROUTINE sbc_cpl_ice_flx( p_frld , & 1048 & pqns_tot, pqns_ice, pqsr_tot , pqsr_ice, & 1049 & pemp_tot, pemp_ice, pdqns_ice, psprecip, & 1050 & palbi , psst , pist ) 1084 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist ) 1051 1085 !!---------------------------------------------------------------------- 1052 !! *** ROUTINE sbc_cpl_ice_flx _rcv***1086 !! *** ROUTINE sbc_cpl_ice_flx *** 1053 1087 !! 1054 1088 !! ** Purpose : provide the heat and freshwater fluxes of the … … 1071 1105 !! the atmosphere 1072 1106 !! 1073 !! N.B. - fields over sea-ice are passed in argument so that1074 !! the module can be compile without sea-ice.1075 1107 !! - the fluxes have been separated from the stress as 1076 1108 !! (a) they are updated at each ice time step compare to … … 1083 1115 !! 1084 1116 !! ** Action : update at each nf_ice time step: 1085 !! pqns_tot, pqsr_tot non-solar and solar total heat fluxes1086 !! pqns_ice, pqsr_ice non-solar and solar heat fluxes over the ice1087 !! pemp_tot total evaporation - precipitation(liquid and solid) (-runoff)(-calving)1088 !! pemp_ice ice sublimation - solid precipitation over the ice1089 !! pdqns_ice d(non-solar heat flux)/d(Temperature) over the ice1117 !! qns_tot, qsr_tot non-solar and solar total heat fluxes 1118 !! qns_ice, qsr_ice non-solar and solar heat fluxes over the ice 1119 !! emp_tot total evaporation - precipitation(liquid and solid) (-runoff)(-calving) 1120 !! emp_ice ice sublimation - solid precipitation over the ice 1121 !! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice 1090 1122 !! sprecip solid precipitation over the ocean 1091 1123 !!---------------------------------------------------------------------- 1092 1124 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 1093 USE wrk_nemo, ONLY: zcptn => wrk_2d_1 ! rcp * tn(:,:,1) 1094 USE wrk_nemo, ONLY: ztmp => wrk_2d_2 ! temporary array 1095 USE wrk_nemo, ONLY: zsnow => wrk_2d_3 ! snow precipitation 1096 USE wrk_nemo, ONLY: zicefr => wrk_3d_4 ! ice fraction 1097 !! 1098 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: p_frld ! lead fraction [0 to 1] 1099 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqns_tot ! total non solar heat flux [W/m2] 1100 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqns_ice ! ice non solar heat flux [W/m2] 1101 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqsr_tot ! total solar heat flux [W/m2] 1102 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqsr_ice ! ice solar heat flux [W/m2] 1103 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_tot ! total freshwater budget [Kg/m2/s] 1104 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_ice ! solid freshwater budget over ice [Kg/m2/s] 1105 REAL(wp), INTENT( out), DIMENSION(:,: ) :: psprecip ! Net solid precipitation (=emp_ice) [Kg/m2/s] 1106 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pdqns_ice ! d(Q non solar)/d(Temperature) over ice 1125 USE wrk_nemo, ONLY: zcptn => wrk_2d_2 ! rcp * tn(:,:,1) 1126 USE wrk_nemo, ONLY: ztmp => wrk_2d_3 ! temporary array 1127 USE wrk_nemo, ONLY: zsnow => wrk_2d_4 ! snow precipitation 1128 USE wrk_nemo, ONLY: zicefr => wrk_2d_5 ! total ice fraction 1129 !! 1130 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1107 1131 ! optional arguments, used only in 'mixed oce-ice' case 1108 1132 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! ice albedo 1109 1133 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celcius] 1110 1134 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1111 !! 1112 INTEGER :: ji, jj ! dummy loop indices 1113 INTEGER :: isec, info ! temporary integer 1114 REAL(wp):: zcoef, ztsurf ! temporary scalar 1135 ! 1136 INTEGER :: jl ! dummy loop index 1115 1137 !!---------------------------------------------------------------------- 1116 1138 1117 IF( wrk_in_use(2, 1,2,3) .OR. wrk_in_use(3, 4) ) THEN1139 IF( wrk_in_use(2, 2,3,4,5) ) THEN 1118 1140 CALL ctl_stop('sbc_cpl_ice_flx: requested workspace arrays unavailable') ; RETURN 1119 1141 ENDIF 1120 1142 1121 zicefr(:,: ,1) = 1.- p_frld(:,:,1)1143 zicefr(:,:) = 1.- p_frld(:,:) 1122 1144 IF( lk_diaar5 ) zcptn(:,:) = rcp * tsn(:,:,1,1) 1123 1145 ! … … 1131 1153 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1132 1154 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1133 pemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_rain)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1134 pemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1135 zsnow (:,:) = frcv(jpr_snow)%z3(:,:,1) 1155 sprecip (:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1156 tprecip (:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here 1157 emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 1158 emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1159 zsnow(:,:) = frcv(jpr_snow)%z3(:,:,1) 1136 1160 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1137 1161 IF( lk_diaar5 ) CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1138 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,: ,1)1162 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1139 1163 CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average) 1140 1164 IF( lk_diaar5 ) CALL iom_put( 'hflx_evap_cea', ztmp(:,: ) * zcptn(:,:) ) ! heat flux from from evap (cell ave) 1141 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp 1142 pemp_tot(:,:) = p_frld(:,:,1) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:,1) * frcv(jpr_sbpr)%z3(:,:,1)1143 pemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1)1165 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1166 emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1167 emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1144 1168 zsnow (:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 1145 1169 END SELECT 1146 psprecip(:,:) = - pemp_ice(:,:) 1170 #if ! defined key_cice 1171 sprecip(:,:) = - emp_ice(:,:) 1172 #endif 1147 1173 CALL iom_put( 'snowpre' , zsnow ) ! Snow 1148 CALL iom_put( 'snow_ao_cea', zsnow(:,: ) * p_frld(:,: ,1) ) ! Snow over ice-free ocean (cell average)1149 CALL iom_put( 'snow_ai_cea', zsnow(:,: ) * zicefr(:,: ,1) ) ! Snow over sea-ice (cell average)1150 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,: ,1) ) ! Sublimation over sea-ice (cell average)1174 CALL iom_put( 'snow_ao_cea', zsnow(:,: ) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1175 CALL iom_put( 'snow_ai_cea', zsnow(:,: ) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1176 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1151 1177 ! 1152 1178 ! ! runoffs and calving (put in emp_tot) 1153 1179 IF( srcv(jpr_rnf)%laction ) THEN 1154 pemp_tot(:,:) = pemp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)1180 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 1155 1181 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers 1156 1182 IF( lk_diaar5 ) CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers 1157 1183 ENDIF 1158 1184 IF( srcv(jpr_cal)%laction ) THEN 1159 pemp_tot(:,:) = pemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)1185 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1160 1186 CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) ) 1161 1187 ENDIF … … 1172 1198 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 1173 1199 !! ENDIF 1174 !! pemp_tot(:,:) = pemp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) ! add runoff to e-p1200 !! emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) ! add runoff to e-p 1175 1201 !! 1176 1202 !!gm end of internal cooking 1177 1178 1203 1179 1204 ! ! ========================= ! … … 1181 1206 ! ! ========================= ! 1182 1207 CASE( 'oce only' ) ! the required field is directly provided 1183 pqns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1)1208 qns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1) 1184 1209 CASE( 'conservative' ) ! the required fields are directly provided 1185 pqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1186 pqns_ice(:,:,1) = frcv(jpr_qnsice)%z3(:,:,1) 1210 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1211 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1212 qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1213 ELSE 1214 ! Set all category values equal for the moment 1215 DO jl=1,jpl 1216 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1217 ENDDO 1218 ENDIF 1187 1219 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1188 pqns_tot(:,: ) = p_frld(:,:,1) * frcv(jpr_qnsoce)%z3(:,:,1) + zicefr(:,:,1) * frcv(jpr_qnsice)%z3(:,:,1) 1189 pqns_ice(:,:,1) = frcv(jpr_qnsice)%z3(:,:,1) 1220 qns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1221 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1222 DO jl=1,jpl 1223 ! ** NEED TO MAKE SURE a_i IS PROPERLY SET AND AVAILABLE IN THIS ROUTINE ** 1224 qns_tot(:,: ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) 1225 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 1226 ENDDO 1227 ELSE 1228 DO jl=1,jpl 1229 qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1230 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1231 ENDDO 1232 ENDIF 1190 1233 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1191 pqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1192 pqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1193 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:,1) & 1194 & + pist(:,:,1) * zicefr(:,:,1) ) ) 1234 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1235 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1236 qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1237 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1238 & + pist(:,:,1) * zicefr(:,:) ) ) 1195 1239 END SELECT 1196 ztmp(:,:) = p_frld(:,: ,1) * zsnow(:,:) * lfus ! add the latent heat of solid precip. melting1197 pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:)! over free ocean1240 ztmp(:,:) = p_frld(:,:) * zsnow(:,:) * lfus ! add the latent heat of solid precip. melting 1241 qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) ! over free ocean 1198 1242 IF( lk_diaar5 ) CALL iom_put( 'hflx_snow_cea', ztmp + zsnow(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1199 1243 !!gm … … 1207 1251 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1208 1252 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1209 pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:)1253 qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 1210 1254 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1211 1255 ENDIF … … 1215 1259 ! ! ========================= ! 1216 1260 CASE( 'oce only' ) 1217 pqsr_tot(:,: ) = frcv(jpr_qsroce)%z3(:,:,1)1261 qsr_tot(:,: ) = MAX(0.0,frcv(jpr_qsroce)%z3(:,:,1)) 1218 1262 CASE( 'conservative' ) 1219 pqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1220 pqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1263 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1264 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1265 qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 1266 ELSE 1267 ! Set all category values equal for the moment 1268 DO jl=1,jpl 1269 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1270 ENDDO 1271 ENDIF 1272 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1273 qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1221 1274 CASE( 'oce and ice' ) 1222 pqsr_tot(:,: ) = p_frld(:,:,1) * frcv(jpr_qsroce)%z3(:,:,1) + zicefr(:,:,1) * frcv(jpr_qsrice)%z3(:,:,1) 1223 pqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1275 qsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1276 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1277 DO jl=1,jpl 1278 ! ** NEED TO MAKE SURE a_i IS PROPERLY SET AND AVAILABLE IN THIS ROUTINE ** 1279 qsr_tot(:,: ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) 1280 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 1281 ENDDO 1282 ELSE 1283 DO jl=1,jpl 1284 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1285 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1286 ENDDO 1287 ENDIF 1224 1288 CASE( 'mixed oce-ice' ) 1225 pqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1289 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1290 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1226 1291 ! Create solar heat flux over ice using incoming solar heat flux and albedos 1227 1292 ! ( see OASIS3 user guide, 5th edition, p39 ) 1228 pqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) &1229 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,: ,1) &1230 & + palbi (:,:,1) * zicefr(:,: ,1) ) )1293 qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1294 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) & 1295 & + palbi (:,:,1) * zicefr(:,:) ) ) 1231 1296 END SELECT 1232 1297 IF( ln_dm2dc ) THEN ! modify qsr to include the diurnal cycle 1233 pqsr_tot(:,: ) = sbc_dcy( pqsr_tot(:,: ) ) 1234 pqsr_ice(:,:,1) = sbc_dcy( pqsr_ice(:,:,1) ) 1298 qsr_tot(:,: ) = sbc_dcy( qsr_tot(:,: ) ) 1299 DO jl=1,jpl 1300 qsr_ice(:,:,jl) = sbc_dcy( qsr_ice(:,:,jl) ) 1301 ENDDO 1235 1302 ENDIF 1236 1303 1237 1304 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 1238 1305 CASE ('coupled') 1239 pdqns_ice(:,:,1) = frcv(jpr_dqnsdt)%z3(:,:,1) 1306 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 1307 dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 1308 ELSE 1309 ! Set all category values equal for the moment 1310 DO jl=1,jpl 1311 dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 1312 ENDDO 1313 ENDIF 1240 1314 END SELECT 1241 1315 1242 IF( wrk_not_released(2, 1,2,3) .OR. & 1243 wrk_not_released(3, 4) ) CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays') 1316 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 1317 CASE ('coupled') 1318 topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) 1319 botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:) 1320 END SELECT 1321 1322 IF( wrk_not_released(2, 2,3,4,5) ) CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays') 1244 1323 ! 1245 1324 END SUBROUTINE sbc_cpl_ice_flx … … 1515 1594 END SUBROUTINE sbc_cpl_ice_tau 1516 1595 ! 1517 SUBROUTINE sbc_cpl_ice_flx( p_frld , & 1518 & pqns_tot, pqns_ice, pqsr_tot , pqsr_ice, & 1519 & pemp_tot, pemp_ice, pdqns_ice, psprecip, & 1520 & palbi , psst , pist ) 1596 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist ) 1521 1597 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: p_frld ! lead fraction [0 to 1] 1522 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqns_tot ! total non solar heat flux [W/m2]1523 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqns_ice ! ice non solar heat flux [W/m2]1524 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqsr_tot ! total solar heat flux [W/m2]1525 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqsr_ice ! ice solar heat flux [W/m2]1526 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_tot ! total freshwater budget [Kg/m2/s]1527 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_ice ! ice solid freshwater budget [Kg/m2/s]1528 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pdqns_ice ! d(Q non solar)/d(Temperature) over ice1529 REAL(wp), INTENT( out), DIMENSION(:,: ) :: psprecip ! solid precipitation [Kg/m2/s]1530 1598 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! ice albedo 1531 1599 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celcius] 1532 1600 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1533 1601 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1,1), palbi(1,1,1), psst(1,1), pist(1,1,1) 1534 ! stupid definition to avoid warning message when compiling...1535 pqns_tot(:,:) = 0. ; pqns_ice(:,:,:) = 0. ; pdqns_ice(:,:,:) = 0.1536 pqsr_tot(:,:) = 0. ; pqsr_ice(:,:,:) = 0.1537 pemp_tot(:,:) = 0. ; pemp_ice(:,:) = 0. ; psprecip(:,:) = 0.1538 1602 END SUBROUTINE sbc_cpl_ice_flx 1539 1603
Note: See TracChangeset
for help on using the changeset viewer.
