- Timestamp:
- 2015-02-17T10:06:39+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r4624 r5086 9 9 !! 3.4 ! 2011_11 (C. Harris) more flexibility + multi-category fields 10 10 !!---------------------------------------------------------------------- 11 #if defined key_oasis3 || defined key_oasis412 !!----------------------------------------------------------------------13 !! 'key_oasis3' or 'key_oasis4' Coupled Ocean/Atmosphere formulation14 11 !!---------------------------------------------------------------------- 15 12 !! namsbc_cpl : coupled formulation namlist … … 34 31 USE ice_2 ! ice variables 35 32 #endif 36 #if defined key_oasis337 33 USE cpl_oasis3 ! OASIS3 coupling 38 #endif39 #if defined key_oasis440 USE cpl_oasis4 ! OASIS4 coupling41 #endif42 34 USE geo2ocean ! 43 35 USE oce , ONLY : tsn, un, vn … … 52 44 USE p4zflx, ONLY : oce_co2 53 45 #endif 54 USE diaar5, ONLY : lk_diaar555 46 #if defined key_cice 56 47 USE ice_domain_size, only: ncat … … 58 49 IMPLICIT NONE 59 50 PRIVATE 60 51 !EM XIOS-OASIS-MCT compliance 52 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 61 53 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90 62 54 PUBLIC sbc_cpl_snd ! routine called by step.F90 63 55 PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim(_2).F90 64 56 PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim(_2).F90 57 PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90 65 58 66 59 INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 1 … … 129 122 TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 130 123 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 124 ! Other namelist parameters ! 125 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 126 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 127 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 128 129 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask 131 130 132 131 TYPE :: DYNARR … … 139 138 140 139 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument 141 142 #if ! defined key_lim2 && ! defined key_lim3143 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj144 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice, alb_ice, qns_ice, dqns_ice ! (jpi,jpj,jpl)145 #endif146 147 #if defined key_cice148 INTEGER, PARAMETER :: jpl = ncat149 #elif ! defined key_lim2 && ! defined key_lim3150 INTEGER, PARAMETER :: jpl = 1151 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice152 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice153 #endif154 155 #if ! defined key_lim3 && ! defined key_cice156 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i157 #endif158 159 #if ! defined key_lim3160 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i, ht_s161 #endif162 163 #if ! defined key_cice164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt, botmelt165 #endif166 140 167 141 !! Substitution … … 179 153 !! *** FUNCTION sbc_cpl_alloc *** 180 154 !!---------------------------------------------------------------------- 181 INTEGER :: ierr( 4),jn155 INTEGER :: ierr(3) 182 156 !!---------------------------------------------------------------------- 183 157 ierr(:) = 0 184 158 ! 185 159 ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) ) 186 ! 187 #if ! defined key_lim2 && ! defined key_lim3 188 ! quick patch to be able to run the coupled model without sea-ice... 189 ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , & 190 v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1), & 191 emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , STAT=ierr(2) ) 160 161 #if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice 162 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 192 163 #endif 193 194 #if ! defined key_lim3 && ! defined key_cice 195 ALLOCATE( a_i(jpi,jpj,jpl) , STAT=ierr(3) ) 196 #endif 197 198 #if defined key_cice || defined key_lim2 199 ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(4) ) 200 #endif 164 ALLOCATE( xcplmask(jpi,jpj,nn_cplmodel) , STAT=ierr(3) ) 165 ! 201 166 sbc_cpl_alloc = MAXVAL( ierr ) 202 167 IF( lk_mpp ) CALL mpp_sum ( sbc_cpl_alloc ) … … 210 175 !! *** ROUTINE sbc_cpl_init *** 211 176 !! 212 !! ** Purpose : Initialisation of send and rec ieved information from177 !! ** Purpose : Initialisation of send and received information from 213 178 !! the atmospheric component 214 179 !! … … 222 187 INTEGER :: jn ! dummy loop index 223 188 INTEGER :: ios ! Local integer output status for namelist read 189 INTEGER :: inum 224 190 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 225 191 !! 226 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 227 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 228 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx , sn_rcv_co2 192 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 193 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 194 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, & 195 & sn_rcv_co2 , nn_cplmodel , ln_usecplmask 229 196 !!--------------------------------------------------------------------- 230 197 ! … … 274 241 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 275 242 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 243 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 244 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 276 245 ENDIF 277 246 … … 485 454 END DO 486 455 ! Allocate taum part of frcv which is used even when not received as coupling field 487 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(j n)%nct) )456 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 488 457 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 489 458 IF( k_ice /= 0 ) THEN 490 IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(j n)%nct) )491 IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(j n)%nct) )459 IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 460 IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 492 461 END IF 493 462 … … 604 573 ! ================================ ! 605 574 606 CALL cpl_prism_define(jprcv, jpsnd) 607 ! 608 IF( ln_dm2dc .AND. ( cpl_prism_freq( jpr_qsroce ) + cpl_prism_freq( jpr_qsrmix ) /= 86400 ) ) & 575 CALL cpl_define(jprcv, jpsnd,nn_cplmodel) 576 IF (ln_usecplmask) THEN 577 xcplmask(:,:,:) = 0. 578 CALL iom_open( 'cplmask', inum ) 579 CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel), & 580 & kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) ) 581 CALL iom_close( inum ) 582 ELSE 583 xcplmask(:,:,:) = 1. 584 ENDIF 585 ! 586 IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) ) & 609 587 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 610 588 … … 654 632 !! 655 633 !! ** Action : update utau, vtau ocean stress at U,V grid 656 !! taum, wndm wind stres and wind speed module at T-point 634 !! taum wind stress module at T-point 635 !! wndm wind speed module at T-point over free ocean or leads in presence of sea-ice 657 636 !! qns non solar heat fluxes including emp heat content (ocean only case) 658 637 !! and the latent heat flux of solid precip. melting … … 678 657 ! 679 658 CALL wrk_alloc( jpi,jpj, ztx, zty ) 680 681 IF( kt == nit000 ) CALL sbc_cpl_init( k_ice ) ! initialisation682 683 659 ! ! Receive all the atmos. fields (including ice information) 684 660 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 685 661 DO jn = 1, jprcv ! received fields sent by the atmosphere 686 IF( srcv(jn)%laction ) CALL cpl_ prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) )662 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) ) 687 663 END DO 688 664 … … 848 824 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 849 825 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 850 ! add the latent heat of solid precip. melting851 IF( srcv(jpr_snow )%laction ) THEN ! update qns over the free ocean with:852 qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus & ! energy for melting solid precipitation over the free ocean853 & - emp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST)826 ! update qns over the free ocean with: 827 qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 828 IF( srcv(jpr_snow )%laction ) THEN 829 qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean 854 830 ENDIF 855 831 … … 914 890 CALL wrk_alloc( jpi,jpj, ztx, zty ) 915 891 916 !AC Pour eviter un stress nul sur la glace dans le cas mixed oce-ice 917 IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN ; itx = jpr_itx1 892 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 918 893 ELSE ; itx = jpr_otx1 919 894 ENDIF … … 922 897 IF( nrcvinfo(itx) == OASIS_Rcv ) THEN 923 898 924 ! ! ======================= ! 925 !AC Pour eviter un stress nul sur la glace dans le cas mixes oce-ice 926 IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN ! ice stress received ! 927 ! ! ======================= ! 899 ! ! ======================= ! 900 IF( srcv(jpr_itx1)%laction ) THEN ! ice stress received ! 901 ! ! ======================= ! 928 902 ! 929 903 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere … … 1125 1099 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1126 1100 ! optional arguments, used only in 'mixed oce-ice' case 1127 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! ice albedo1128 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Cel cius]1101 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1102 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1129 1103 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1130 1104 ! … … 1153 1127 emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 1154 1128 emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1155 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1156 IF( lk_diaar5 ) CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1157 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1158 CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average) 1159 IF( lk_diaar5 ) CALL iom_put( 'hflx_evap_cea', ztmp(:,: ) * zcptn(:,:) ) ! heat flux from from evap (cell ave) 1129 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1130 IF( iom_use('hflx_rain_cea') ) & 1131 CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1132 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) & 1133 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1134 IF( iom_use('evap_ao_cea' ) ) & 1135 CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average) 1136 IF( iom_use('hflx_evap_cea') ) & 1137 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) ) ! heat flux from from evap (cell average) 1160 1138 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1161 1139 emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) … … 1164 1142 END SELECT 1165 1143 1166 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1167 CALL iom_put( 'snow_ao_cea', sprecip(:,: ) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1168 CALL iom_put( 'snow_ai_cea', sprecip(:,: ) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1169 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1144 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1145 IF( iom_use('snow_ao_cea') ) & 1146 CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1147 IF( iom_use('snow_ai_cea') ) & 1148 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1149 IF( iom_use('subl_ai_cea') ) & 1150 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1170 1151 ! 1171 1152 ! ! runoffs and calving (put in emp_tot) 1172 1153 IF( srcv(jpr_rnf)%laction ) THEN 1173 1154 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 1174 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers 1175 IF( lk_diaar5 ) CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers 1155 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers 1156 IF( iom_use('hflx_rnf_cea') ) & 1157 CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers 1176 1158 ENDIF 1177 1159 IF( srcv(jpr_cal)%laction ) THEN … … 1235 1217 & - ( emp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1236 1218 & - emp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:) 1237 IF( lk_diaar5 ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1219 IF( iom_use('hflx_snow_cea') ) & 1220 CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1238 1221 !!gm 1239 1222 !! currently it is taken into account in leads budget but not in the qns_tot, and thus not in … … 1247 1230 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1248 1231 qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 1249 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1232 IF( iom_use('hflx_cal_cea') ) & 1233 CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1250 1234 ENDIF 1251 1235 … … 1296 1280 ENDIF 1297 1281 1298 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 1282 ! ! ========================= ! 1283 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt ! 1284 ! ! ========================= ! 1299 1285 CASE ('coupled') 1300 1286 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN … … 1308 1294 END SELECT 1309 1295 1310 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 1296 ! ! ========================= ! 1297 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt ! 1298 ! ! ========================= ! 1311 1299 CASE ('coupled') 1312 1300 topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) … … 1314 1302 END SELECT 1315 1303 1316 ! Ice Qsr penetration used (only?)in lim2 or lim3 1317 ! fraction of net shortwave radiation which is not absorbed in the thin surface layer 1318 ! and penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 1304 ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 ) 1305 ! Used for LIM2 and LIM3 1319 1306 ! Coupled case: since cloud cover is not received from atmosphere 1320 ! ===> defined as constant value -> definition done in sbc_cpl_init 1321 fr1_i0(:,:) = 0.18 1322 fr2_i0(:,:) = 0.82 1323 1307 ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 1308 fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 1309 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1324 1310 1325 1311 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) … … 1336 1322 !! ** Purpose : provide the ocean-ice informations to the atmosphere 1337 1323 !! 1338 !! ** Method : send to the atmosphere through a call to cpl_ prism_snd1324 !! ** Method : send to the atmosphere through a call to cpl_snd 1339 1325 !! all the needed fields (as defined in sbc_cpl_init) 1340 1326 !!---------------------------------------------------------------------- … … 1355 1341 1356 1342 zfr_l(:,:) = 1.- fr_i(:,:) 1357 1358 1343 ! ! ------------------------- ! 1359 1344 ! ! Surface temperature ! in Kelvin … … 1374 1359 END SELECT 1375 1360 CASE( 'mixed oce-ice' ) 1376 ztmp1(:,:) = ( tsn(:,:,1, 1) + rt0 ) * zfr_l(:,:)1361 ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1377 1362 DO jl=1,jpl 1378 1363 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) … … 1380 1365 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1381 1366 END SELECT 1382 IF( ssnd(jps_toce)%laction ) CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1383 IF( ssnd(jps_tice)%laction ) CALL cpl_prism_snd( jps_tice, isec, ztmp3, info ) 1384 IF( ssnd(jps_tmix)%laction ) CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1385 ENDIF 1386 ! 1367 IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1368 IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info ) 1369 IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1370 ENDIF 1387 1371 ! ! ------------------------- ! 1388 1372 ! ! Albedo ! … … 1390 1374 IF( ssnd(jps_albice)%laction ) THEN ! ice 1391 1375 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1392 CALL cpl_ prism_snd( jps_albice, isec, ztmp3, info )1376 CALL cpl_snd( jps_albice, isec, ztmp3, info ) 1393 1377 ENDIF 1394 1378 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean … … 1397 1381 ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 1398 1382 ENDDO 1399 CALL cpl_ prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )1383 CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1400 1384 ENDIF 1401 1385 ! ! ------------------------- ! … … 1409 1393 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1410 1394 END SELECT 1411 CALL cpl_ prism_snd( jps_fice, isec, ztmp3, info )1395 CALL cpl_snd( jps_fice, isec, ztmp3, info ) 1412 1396 ENDIF 1413 1397 … … 1434 1418 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 1435 1419 END SELECT 1436 IF( ssnd(jps_hice)%laction ) CALL cpl_ prism_snd( jps_hice, isec, ztmp3, info )1437 IF( ssnd(jps_hsnw)%laction ) CALL cpl_ prism_snd( jps_hsnw, isec, ztmp4, info )1420 IF( ssnd(jps_hice)%laction ) CALL cpl_snd( jps_hice, isec, ztmp3, info ) 1421 IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 1438 1422 ENDIF 1439 1423 ! … … 1442 1426 ! ! CO2 flux from PISCES ! 1443 1427 ! ! ------------------------- ! 1444 IF( ssnd(jps_co2)%laction ) CALL cpl_ prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )1428 IF( ssnd(jps_co2)%laction ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 1445 1429 ! 1446 1430 #endif … … 1565 1549 ENDIF 1566 1550 ! 1567 IF( ssnd(jps_ocx1)%laction ) CALL cpl_ prism_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid1568 IF( ssnd(jps_ocy1)%laction ) CALL cpl_ prism_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid1569 IF( ssnd(jps_ocz1)%laction ) CALL cpl_ prism_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid1551 IF( ssnd(jps_ocx1)%laction ) CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid 1552 IF( ssnd(jps_ocy1)%laction ) CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid 1553 IF( ssnd(jps_ocz1)%laction ) CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid 1570 1554 ! 1571 IF( ssnd(jps_ivx1)%laction ) CALL cpl_ prism_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid1572 IF( ssnd(jps_ivy1)%laction ) CALL cpl_ prism_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid1573 IF( ssnd(jps_ivz1)%laction ) CALL cpl_ prism_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid1555 IF( ssnd(jps_ivx1)%laction ) CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid 1556 IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid 1557 IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid 1574 1558 ! 1575 1559 ENDIF … … 1582 1566 END SUBROUTINE sbc_cpl_snd 1583 1567 1584 #else1585 !!----------------------------------------------------------------------1586 !! Dummy module NO coupling1587 !!----------------------------------------------------------------------1588 USE par_kind ! kind definition1589 CONTAINS1590 SUBROUTINE sbc_cpl_snd( kt )1591 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt1592 END SUBROUTINE sbc_cpl_snd1593 !1594 SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )1595 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt, k_fsbc, k_ice1596 END SUBROUTINE sbc_cpl_rcv1597 !1598 SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )1599 REAL(wp), INTENT(out), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2]1600 REAL(wp), INTENT(out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid)1601 p_taui(:,:) = 0. ; p_tauj(:,:) = 0. ! stupid definition to avoid warning message when compiling...1602 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?'1603 END SUBROUTINE sbc_cpl_ice_tau1604 !1605 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist )1606 REAL(wp), INTENT(in ), DIMENSION(:,: ) :: p_frld ! lead fraction [0 to 1]1607 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! ice albedo1608 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celcius]1609 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin]1610 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1), palbi(1,1,1), psst(1,1), pist(1,1,1)1611 END SUBROUTINE sbc_cpl_ice_flx1612 1613 #endif1614 1615 1568 !!====================================================================== 1616 1569 END MODULE sbccpl
Note: See TracChangeset
for help on using the changeset viewer.
