Changeset 4990 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
- Timestamp:
- 2014-12-15T17:42:49+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r4664 r4990 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 … … 129 121 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 122 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 123 ! Other namelist parameters ! 124 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 125 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 126 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 127 128 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask 131 129 132 130 TYPE :: DYNARR … … 139 137 140 138 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 139 167 140 !! Substitution … … 179 152 !! *** FUNCTION sbc_cpl_alloc *** 180 153 !!---------------------------------------------------------------------- 181 INTEGER :: ierr( 4),jn154 INTEGER :: ierr(3) 182 155 !!---------------------------------------------------------------------- 183 156 ierr(:) = 0 184 157 ! 185 158 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) ) 159 160 #if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice 161 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 162 #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 163 ALLOCATE( xcplmask(jpi,jpj,nn_cplmodel) , STAT=ierr(3) ) 164 ! 201 165 sbc_cpl_alloc = MAXVAL( ierr ) 202 166 IF( lk_mpp ) CALL mpp_sum ( sbc_cpl_alloc ) … … 210 174 !! *** ROUTINE sbc_cpl_init *** 211 175 !! 212 !! ** Purpose : Initialisation of send and rec ieved information from176 !! ** Purpose : Initialisation of send and received information from 213 177 !! the atmospheric component 214 178 !! … … 222 186 INTEGER :: jn ! dummy loop index 223 187 INTEGER :: ios ! Local integer output status for namelist read 188 INTEGER :: inum 224 189 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 225 190 !! 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 191 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 192 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 193 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, & 194 & sn_rcv_co2 , nn_cplmodel , ln_usecplmask 229 195 !!--------------------------------------------------------------------- 230 196 ! … … 274 240 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 275 241 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 242 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 243 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 276 244 ENDIF 277 245 … … 485 453 END DO 486 454 ! 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) )455 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 488 456 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 489 457 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) )458 IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 459 IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 492 460 END IF 493 461 … … 604 572 ! ================================ ! 605 573 606 CALL cpl_prism_define(jprcv, jpsnd) 607 ! 608 IF( ln_dm2dc .AND. ( cpl_prism_freq( jpr_qsroce ) + cpl_prism_freq( jpr_qsrmix ) /= 86400 ) ) & 574 CALL cpl_define(jprcv, jpsnd,nn_cplmodel) 575 IF (ln_usecplmask) THEN 576 xcplmask(:,:,:) = 0. 577 CALL iom_open( 'cplmask', inum ) 578 CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel), & 579 & kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) ) 580 CALL iom_close( inum ) 581 ELSE 582 xcplmask(:,:,:) = 1. 583 ENDIF 584 ! 585 IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) ) & 609 586 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 610 587 … … 654 631 !! 655 632 !! ** Action : update utau, vtau ocean stress at U,V grid 656 !! taum, wndm wind stres and wind speed module at T-point 633 !! taum wind stress module at T-point 634 !! wndm wind speed module at T-point over free ocean or leads in presence of sea-ice 657 635 !! qns non solar heat fluxes including emp heat content (ocean only case) 658 636 !! and the latent heat flux of solid precip. melting … … 678 656 ! 679 657 CALL wrk_alloc( jpi,jpj, ztx, zty ) 680 681 IF( kt == nit000 ) CALL sbc_cpl_init( k_ice ) ! initialisation682 683 658 ! ! Receive all the atmos. fields (including ice information) 684 659 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 685 660 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) )661 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) ) 687 662 END DO 688 663 … … 848 823 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 849 824 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)825 ! update qns over the free ocean with: 826 qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 827 IF( srcv(jpr_snow )%laction ) THEN 828 qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean 854 829 ENDIF 855 830 … … 914 889 CALL wrk_alloc( jpi,jpj, ztx, zty ) 915 890 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 891 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 918 892 ELSE ; itx = jpr_otx1 919 893 ENDIF … … 922 896 IF( nrcvinfo(itx) == OASIS_Rcv ) THEN 923 897 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 ! ! ======================= ! 898 ! ! ======================= ! 899 IF( srcv(jpr_itx1)%laction ) THEN ! ice stress received ! 900 ! ! ======================= ! 928 901 ! 929 902 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere … … 1125 1098 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1126 1099 ! 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]1100 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1101 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1129 1102 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1130 1103 ! … … 1153 1126 emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 1154 1127 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) 1128 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1129 IF( iom_use('hflx_rain_cea') ) & 1130 CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1131 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) & 1132 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1133 IF( iom_use('evap_ao_cea' ) ) & 1134 CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average) 1135 IF( iom_use('hflx_evap_cea') ) & 1136 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) ) ! heat flux from from evap (cell average) 1160 1137 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1161 1138 emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) … … 1164 1141 END SELECT 1165 1142 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) 1143 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1144 IF( iom_use('snow_ao_cea') ) & 1145 CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1146 IF( iom_use('snow_ai_cea') ) & 1147 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1148 IF( iom_use('subl_ai_cea') ) & 1149 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1170 1150 ! 1171 1151 ! ! runoffs and calving (put in emp_tot) 1172 1152 IF( srcv(jpr_rnf)%laction ) THEN 1173 1153 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 1154 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers 1155 IF( iom_use('hflx_rnf_cea') ) & 1156 CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers 1176 1157 ENDIF 1177 1158 IF( srcv(jpr_cal)%laction ) THEN … … 1235 1216 & - ( emp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1236 1217 & - emp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:) 1237 IF( lk_diaar5 ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1218 IF( iom_use('hflx_snow_cea') ) & 1219 CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1238 1220 !!gm 1239 1221 !! currently it is taken into account in leads budget but not in the qns_tot, and thus not in … … 1247 1229 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1248 1230 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 1231 IF( iom_use('hflx_cal_cea') ) & 1232 CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1250 1233 ENDIF 1251 1234 … … 1296 1279 ENDIF 1297 1280 1298 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 1281 ! ! ========================= ! 1282 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt ! 1283 ! ! ========================= ! 1299 1284 CASE ('coupled') 1300 1285 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN … … 1308 1293 END SELECT 1309 1294 1310 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 1295 ! ! ========================= ! 1296 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt ! 1297 ! ! ========================= ! 1311 1298 CASE ('coupled') 1312 1299 topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) … … 1314 1301 END SELECT 1315 1302 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 ) 1303 ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 ) 1304 ! Used for LIM2 and LIM3 1319 1305 ! 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 1306 ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 1307 fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 1308 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1324 1309 1325 1310 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) … … 1336 1321 !! ** Purpose : provide the ocean-ice informations to the atmosphere 1337 1322 !! 1338 !! ** Method : send to the atmosphere through a call to cpl_ prism_snd1323 !! ** Method : send to the atmosphere through a call to cpl_snd 1339 1324 !! all the needed fields (as defined in sbc_cpl_init) 1340 1325 !!---------------------------------------------------------------------- … … 1355 1340 1356 1341 zfr_l(:,:) = 1.- fr_i(:,:) 1357 1358 1342 ! ! ------------------------- ! 1359 1343 ! ! Surface temperature ! in Kelvin … … 1380 1364 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1381 1365 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 ! 1366 IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1367 IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info ) 1368 IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1369 ENDIF 1387 1370 ! ! ------------------------- ! 1388 1371 ! ! Albedo ! … … 1390 1373 IF( ssnd(jps_albice)%laction ) THEN ! ice 1391 1374 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1392 CALL cpl_ prism_snd( jps_albice, isec, ztmp3, info )1375 CALL cpl_snd( jps_albice, isec, ztmp3, info ) 1393 1376 ENDIF 1394 1377 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean … … 1397 1380 ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 1398 1381 ENDDO 1399 CALL cpl_ prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )1382 CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1400 1383 ENDIF 1401 1384 ! ! ------------------------- ! … … 1409 1392 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1410 1393 END SELECT 1411 CALL cpl_ prism_snd( jps_fice, isec, ztmp3, info )1394 CALL cpl_snd( jps_fice, isec, ztmp3, info ) 1412 1395 ENDIF 1413 1396 … … 1434 1417 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 1435 1418 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 )1419 IF( ssnd(jps_hice)%laction ) CALL cpl_snd( jps_hice, isec, ztmp3, info ) 1420 IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 1438 1421 ENDIF 1439 1422 ! … … 1442 1425 ! ! CO2 flux from PISCES ! 1443 1426 ! ! ------------------------- ! 1444 IF( ssnd(jps_co2)%laction ) CALL cpl_ prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )1427 IF( ssnd(jps_co2)%laction ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 1445 1428 ! 1446 1429 #endif … … 1565 1548 ENDIF 1566 1549 ! 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 grid1550 IF( ssnd(jps_ocx1)%laction ) CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid 1551 IF( ssnd(jps_ocy1)%laction ) CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid 1552 IF( ssnd(jps_ocz1)%laction ) CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid 1570 1553 ! 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 grid1554 IF( ssnd(jps_ivx1)%laction ) CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid 1555 IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid 1556 IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid 1574 1557 ! 1575 1558 ENDIF … … 1582 1565 END SUBROUTINE sbc_cpl_snd 1583 1566 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 1567 !!====================================================================== 1616 1568 END MODULE sbccpl
Note: See TracChangeset
for help on using the changeset viewer.