Changeset 4901
- Timestamp:
- 2014-11-27T16:41:22+01:00 (9 years ago)
- Location:
- branches/2014/dev_CNRS_2014/NEMOGCM
- Files:
-
- 2 deleted
- 41 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml
r4900 r4901 326 326 <variable id="buffer_server_factor_size" type="integer">2</variable> 327 327 <variable id="info_level" type="integer">0</variable> 328 <variable id="using_server" type="boolean"> true</variable>328 <variable id="using_server" type="boolean">false</variable> 329 329 <variable id="using_oasis" type="boolean">false</variable> 330 330 <variable id="oasis_codes_id" type="string" >oceanx</variable> -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/SHARED/field_def.xml
r4896 r4901 210 210 <field id="icethic_cea" long_name="Ice thickness (cell average)" unit="m" /> 211 211 <field id="iceprod_cea" long_name="Ice production (cell average)" unit="m/s" /> 212 <field id="iiceconc" long_name="Ice concentration" unit="" /> 212 213 213 214 <field id="ice_pres" long_name="Ice presence" unit="-" /> -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/SHARED/namelist_ref
r4900 r4901 231 231 ln_blk_core = .true. ! CORE bulk formulation (T => fill namsbc_core) 232 232 ln_blk_mfs = .false. ! MFS bulk formulation (T => fill namsbc_mfs ) 233 ln_cpl = .false. ! Coupled formulation (T => fill namsbc_cpl )234 233 ln_apr_dyn = .false. ! Patm gradient added in ocean & ice Eqs. (T => fill namsbc_apr ) 235 234 nn_ice = 2 ! =0 no ice boundary condition , 236 235 ! =1 use observed ice-cover , 237 ! =2 ice-model used ("key_lim3" or "key_lim2 )236 ! =2 ice-model used ("key_lim3" or "key_lim2") 238 237 nn_ice_embd = 1 ! =0 levitating ice (no mass exchange, concentration/dilution effect) 239 238 ! =1 levitating ice with mass and salt exchange but no presure effect … … 251 250 nn_lsm = 0 ! =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) , 252 251 ! =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field) 253 cn_iceflx = 'linear' ! redistribution of solar input into ice categories during coupling ice/atm. 252 nn_limflx = -1 ! LIM3 Multi-category heat flux formulation (use -1 if LIM3 is not used) 253 ! =-1 Use per-category fluxes, bypass redistributor, forced mode only, not yet implemented coupled 254 ! = 0 Average per-category fluxes (forced and coupled mode) 255 ! = 1 Average and redistribute per-category fluxes, forced mode only, not yet implemented coupled 256 ! = 2 Redistribute a single flux over categories (coupled mode only) 254 257 / 255 258 !----------------------------------------------------------------------- … … 336 339 ! ! ! categories ! reference ! orientation ! grids ! 337 340 ! send 338 sn_snd_temp = 'weighted oce and ice' , 'no' , '' , '' , ''339 sn_snd_alb = 'weighted ice' , 'no' , '' , '' , ''340 sn_snd_thick = 'none' , 'no' , '' , '' , ''341 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T'342 sn_snd_co2 = 'coupled' , 'no' , '' , '' , ''341 sn_snd_temp = 'weighted oce and ice' , 'no' , '' , '' , '' 342 sn_snd_alb = 'weighted ice' , 'no' , '' , '' , '' 343 sn_snd_thick = 'none' , 'no' , '' , '' , '' 344 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' 345 sn_snd_co2 = 'coupled' , 'no' , '' , '' , '' 343 346 ! receive 344 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' 345 sn_rcv_taumod = 'coupled' , 'no' , '' , '' , '' 346 sn_rcv_tau = 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' 347 sn_rcv_dqnsdt = 'coupled' , 'no' , '' , '' , '' 348 sn_rcv_qsr = 'oce and ice' , 'no' , '' , '' , '' 349 sn_rcv_qns = 'oce and ice' , 'no' , '' , '' , '' 350 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 351 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 352 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 353 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 347 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' 348 sn_rcv_taumod = 'coupled' , 'no' , '' , '' , '' 349 sn_rcv_tau = 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' 350 sn_rcv_dqnsdt = 'coupled' , 'no' , '' , '' , '' 351 sn_rcv_qsr = 'oce and ice' , 'no' , '' , '' , '' 352 sn_rcv_qns = 'oce and ice' , 'no' , '' , '' , '' 353 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 354 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 355 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 356 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 357 ! 358 nn_cplmodel = 1 ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 359 ln_usecplmask = .false. ! use a coupling mask file to merge data received from several models 360 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 354 361 / 355 362 !----------------------------------------------------------------------- -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/cfg.txt
r4900 r4901 1 1 GYRE_PISCES OPA_SRC TOP_SRC 2 2 ORCA2_LIM_CFC_C14b OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 3 GYRE OPA_SRC4 3 GYRE_XIOS OPA_SRC 5 4 ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC … … 10 9 GYRE_BFM OPA_SRC TOP_SRC 11 10 ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 11 GYRE OPA_SRC 12 12 ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r4306 r4901 30 30 USE sbc_oce ! surface boundary condition: ocean 31 31 USE sbccpl 32 USE cpl_oasis3, ONLY : lk_cpl33 32 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 34 33 USE albedo ! albedo parameters … … 97 96 !! - emp : freshwater budget: mass flux 98 97 !! - sfx : freshwater budget: salt flux due to Freezing/Melting 99 !! - utau : sea surface i-stress (ocean referential)100 !! - vtau : sea surface j-stress (ocean referential)101 98 !! - fr_i : ice fraction 102 99 !! - tn_ice : sea-ice surface temperature 103 !! - alb_ice : sea-ice albe rdo (lk_cpl=T)100 !! - alb_ice : sea-ice albedo (lk_cpl=T) 104 101 !! 105 102 !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. … … 183 180 184 181 ! computation the solar flux at ocean surface 185 #if defined key_coupled 186 zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) )187 #else 188 zqsr = pfrld(ji,jj) * qsr(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj)189 #endif 182 IF( lk_cpl ) THEN 183 zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 184 ELSE 185 zqsr = pfrld(ji,jj) * qsr(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 186 ENDIF 190 187 ! computation the non solar heat flux at ocean surface 191 188 zqns = - ( 1. - thcm(ji,jj) ) * zqsr & ! part of the solar energy used in leads … … 206 203 ! 207 204 ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area) 208 #if defined key_coupled209 205 ! ! coupled mode: 210 zemp = + emp_tot(ji,jj) & ! net mass flux over the grid cell (ice+ocean area) 211 & - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) ! minus the mass flux intercepted by sea-ice 212 #else 213 ! ! forced mode: 214 zemp = + emp(ji,jj) * frld(ji,jj) & ! mass flux over open ocean fraction 215 & - tprecip(ji,jj) * ( 1. - frld(ji,jj) ) & ! liquid precip. over ice reaches directly the ocean 216 & + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) ! snow is intercepted by sea-ice (previous frld) 217 #endif 206 IF( lk_cpl ) THEN 207 zemp = + emp_tot(ji,jj) & ! net mass flux over the grid cell (ice+ocean area) 208 & - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) ! minus the mass flux intercepted by sea-ice 209 ELSE 210 ! ! forced mode: 211 zemp = + emp(ji,jj) * frld(ji,jj) & ! mass flux over open ocean fraction 212 & - tprecip(ji,jj) * ( 1. - frld(ji,jj) ) & ! liquid precip. over ice reaches directly the ocean 213 & + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) ! snow is intercepted by sea-ice (previous frld) 214 ENDIF 218 215 ! 219 216 ! mass flux at the ocean/ice interface (sea ice fraction) … … 259 256 !-----------------------------------------------! 260 257 261 #if defined key_coupled 262 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature263 ht_i(:,:,1) = hicif(:,:)264 ht_s(:,:,1) = hsnif(:,:)265 a_i(:,:,1) = fr_i(:,:)266 ! ! Computation of snow/ice and ocean albedo267 CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb )268 alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys)269 CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) ) ! ice albedo270 #endif 258 IF( lk_cpl) THEN 259 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature 260 ht_i(:,:,1) = hicif(:,:) 261 ht_s(:,:,1) = hsnif(:,:) 262 a_i(:,:,1) = fr_i(:,:) 263 ! ! Computation of snow/ice and ocean albedo 264 CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb ) 265 alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys) 266 CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) ) ! ice albedo 267 ENDIF 271 268 272 269 IF(ln_ctl) THEN ! control print 273 270 CALL prt_ctl(tab2d_1=qsr , clinfo1=' lim_sbc: qsr : ', tab2d_2=qns , clinfo2=' qns : ') 274 271 CALL prt_ctl(tab2d_1=emp , clinfo1=' lim_sbc: emp : ', tab2d_2=sfx , clinfo2=' sfx : ') 275 CALL prt_ctl(tab2d_1=utau , clinfo1=' lim_sbc: utau : ', mask1=umask, &276 & tab2d_2=vtau , clinfo2=' vtau : ' , mask2=vmask )277 272 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' lim_sbc: fr_i : ', tab2d_2=tn_ice(:,:,1), clinfo2=' tn_ice : ') 278 273 ENDIF -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r4900 r4901 33 33 USE limtab_2 34 34 USE prtctl ! Print control 35 USE cpl_oasis3, ONLY : lk_cpl36 35 USE diaar5 , ONLY : lk_diaar5 37 36 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 219 218 220 219 ! partial computation of the lead energy budget (qldif) 221 #if defined key_coupled222 qldif(ji,jj) = tms(ji,jj) * rdt_ice &223 & * ( ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) ) &224 & + ( qns_tot(ji,jj) - qns_ice(ji,jj,1) * zfricp ) &225 & + frld(ji,jj) * ( fdtcn(ji,jj) + ( 1.0 - zindb ) * fsbbq(ji,jj) ) )226 #else 227 qldif(ji,jj) = tms(ji,jj) * rdt_ice * frld(ji,jj) &228 & * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) ) &229 & + qns(ji,jj) + fdtcn(ji,jj) &230 & + ( 1.0 - zindb ) * fsbbq(ji,jj) )231 #endif 220 IF( lk_cpl ) THEN 221 qldif(ji,jj) = tms(ji,jj) * rdt_ice & 222 & * ( ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) ) & 223 & + ( qns_tot(ji,jj) - qns_ice(ji,jj,1) * zfricp ) & 224 & + frld(ji,jj) * ( fdtcn(ji,jj) + ( 1.0 - zindb ) * fsbbq(ji,jj) ) ) 225 ELSE 226 qldif(ji,jj) = tms(ji,jj) * rdt_ice * frld(ji,jj) & 227 & * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) ) & 228 & + qns(ji,jj) + fdtcn(ji,jj) & 229 & + ( 1.0 - zindb ) * fsbbq(ji,jj) ) 230 ENDIF 232 231 ! parlat : percentage of energy used for lateral ablation (0.0) 233 232 zfntlat = 1.0 - MAX( rzero , SIGN( rone , - qldif(ji,jj) ) ) … … 449 448 zztmp = 1.0 / rdt_ice 450 449 CALL iom_put( 'iceprod_cea' , hicifp (:,:) * zztmp ) ! Ice produced [m/s] 450 CALL iom_put( 'iiceconc' , fr_i(:,:) ) ! Ice concentration [-] 451 451 IF( lk_diaar5 ) THEN 452 452 CALL iom_put( 'snowmel_cea' , rdm_snw(:,:) * zztmp ) ! Snow melt [kg/m2/s] -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
r4306 r4901 18 18 USE ice_2 19 19 USE limistate_2 20 USE cpl_oasis3, ONLY : lk_cpl20 USE sbc_oce, ONLY : lk_cpl 21 21 USE in_out_manager 22 22 USE lib_mpp ! MPP library -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90
r4897 r4901 89 89 CALL lim_itd_ini ! ice thickness distribution initialization 90 90 ! 91 CALL lim_itd_me_init ! ice thickness distribution initialization 91 92 ! ! Initial sea-ice state 92 93 IF( .NOT. ln_rstart ) THEN ! start from rest -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r4900 r4901 29 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 30 30 USE wrk_nemo ! work arrays 31 USE cpl_oasis3, ONLY : lk_cpl32 31 33 32 IMPLICIT NONE … … 113 112 114 113 CALL lim_istate_init ! reading the initials parameters of the ice 115 116 # if defined key_coupled117 albege(:,:) = 0.8 * tms(:,:)118 # endif119 114 120 115 ! surface temperature -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r4900 r4901 150 150 CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 151 151 152 IF( numit == nstart ) CALL lim_itd_me_init ! Initialization (first time-step only)153 154 152 IF(ln_ctl) THEN 155 153 CALL prt_ctl(tab2d_1=ato_i , clinfo1=' lim_itd_me: ato_i : ', tab2d_2=at_i , clinfo2=' at_i : ') … … 1037 1035 ! / rafting category n1. 1038 1036 !-------------------------------------------------------------------------- 1039 vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por )1037 vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) 1040 1038 vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + ridge_por ) 1041 1039 vsw (ji,jj) = vrdg1(ji,jj) * ridge_por … … 1043 1041 vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 1044 1042 esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 1045 srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por )1043 srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 1046 1044 srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless 1047 1045 … … 1128 1126 jj = indxj(ij) 1129 1127 ! heat content of ridged ice 1130 erdg1(ji,jj,jk) = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por )1128 erdg1(ji,jj,jk) = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) 1131 1129 eirft(ji,jj,jk) = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj) 1132 1130 e_i (ji,jj,jk,jl1) = e_i(ji,jj,jk,jl1) - erdg1(ji,jj,jk) - eirft(ji,jj,jk) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r4900 r4901 32 32 USE sbc_oce ! Surface boundary condition: ocean fields 33 33 USE sbccpl 34 USE cpl_oasis3, ONLY : lk_cpl 35 USE oce , ONLY : iatte, oatte, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 34 USE oce , ONLY : fraqsr_1lev, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 36 35 USE albedo ! albedo parameters 37 36 USE lbclnk ! ocean lateral boundary condition - MPP exchanges … … 98 97 !! - fr_i : ice fraction 99 98 !! - tn_ice : sea-ice surface temperature 100 !! - alb_ice : sea-ice albe rdo (lk_cpl=T)99 !! - alb_ice : sea-ice albedo (lk_cpl=T) 101 100 !! 102 101 !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 103 102 !! Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 103 !! These refs are now obsolete since everything has been revised 104 !! The ref should be Rousset et al., 2015? 104 105 !!--------------------------------------------------------------------- 105 INTEGER, INTENT(in) :: kt ! number of iteration 106 ! 107 INTEGER :: ji, jj, jl, jk ! dummy loop indices 108 REAL(wp) :: zinda, zemp ! local scalars 109 REAL(wp) :: zf_mass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 110 REAL(wp) :: zfcm1 ! New solar flux received by the ocean 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 106 INTEGER, INTENT(in) :: kt ! number of iteration 107 ! 108 INTEGER :: ji, jj, jl, jk ! dummy loop indices 109 ! 110 REAL(wp) :: zinda, zemp ! local scalars 111 REAL(wp) :: zf_mass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 112 REAL(wp) :: zfcm1 ! New solar flux received by the ocean 113 ! 114 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 2D/3D workspace 112 115 !!--------------------------------------------------------------------- 113 114 IF( lk_cpl ) CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp )115 116 116 117 ! make calls for heat fluxes before it is modified … … 134 135 ! Solar heat flux reaching the ocean = zfcm1 (W.m-2) 135 136 !--------------------------------------------------- 136 IF( lk_cpl ) THEN ! be carfeful: not been tested yet137 ! original line137 IF( lk_cpl ) THEN 138 !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 138 139 zfcm1 = qsr_tot(ji,jj) 139 !!!zfcm1 = qsr_tot(ji,jj) + ftr_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) / ( 1._wp - zinda + zinda * iatte(ji,jj) )140 140 DO jl = 1, jpl 141 zfcm1 = zfcm1 - ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) * old_a_i(ji,jj,jl)141 zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * old_a_i(ji,jj,jl) 142 142 END DO 143 143 ELSE 144 !!!zfcm1 = pfrld(ji,jj) * qsr(ji,jj) + & 145 !!! & ( 1._wp - pfrld(ji,jj) ) * ftr_ice(ji,jj) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 144 !!! LIM2 version zqsr = pfrld(ji,jj) * qsr(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 146 145 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) 147 146 DO jl = 1, jpl … … 215 214 216 215 !------------------------------------------------! 217 ! Computation of snow/ice and ocean albedo!216 ! Snow/ice albedo (only if sent to coupler) ! 218 217 !------------------------------------------------! 219 218 IF( lk_cpl ) THEN ! coupled case 220 CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb ) ! snow/ice albedo 221 alb_ice(:,:,:) = 0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:) ! Ice albedo (mean clear and overcast skys) 219 220 CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 221 222 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 223 224 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 225 226 CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 227 222 228 ENDIF 223 229 … … 229 235 CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 230 236 ENDIF 231 ! 232 IF( lk_cpl ) CALL wrk_dealloc( jpi, jpj, jpl, zalb, zalbp ) 233 ! 237 234 238 END SUBROUTINE lim_sbc_flx 235 239 … … 344 348 ! clem modif 345 349 IF( .NOT. ln_rstart ) THEN 346 iatte(:,:) = 1._wp 347 oatte(:,:) = 1._wp 350 fraqsr_1lev(:,:) = 1._wp 348 351 ENDIF 349 352 ! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r4900 r4901 22 22 USE phycst ! physical constants 23 23 USE dom_oce ! ocean space and time domain variables 24 USE oce , ONLY : iatte, oatte24 USE oce , ONLY : fraqsr_1lev 25 25 USE ice ! LIM: sea-ice variables 26 26 USE par_ice ! LIM: sea-ice parameters … … 43 43 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 44 44 USE timing ! Timing 45 USE cpl_oasis3, ONLY : lk_cpl46 45 USE limcons ! conservation tests 47 46 … … 68 67 !! *** ROUTINE lim_thd *** 69 68 !! 70 !! ** Purpose : This routine manages the ice thermodynamic.69 !! ** Purpose : This routine manages ice thermodynamics 71 70 !! 72 71 !! ** Action : - Initialisation of some variables … … 74 73 !! at the ice base, snow acc.,heat budget of the leads) 75 74 !! - selection of the icy points and put them in an array 76 !! - call lim_vert_ther for vert ice thermodynamic 77 !! - back to the geographic grid 78 !! - selection of points for lateral accretion 79 !! - call lim_lat_acc for the ice accretion 75 !! - call lim_thd_dif for vertical heat diffusion 76 !! - call lim_thd_dh for vertical ice growth and melt 77 !! - call lim_thd_ent for enthalpy remapping 78 !! - call lim_thd_sal for ice desalination 79 !! - call lim_thd_temp to retrieve temperature from ice enthalpy 80 80 !! - back to the geographic grid 81 81 !! 82 !! ** References : H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-9082 !! ** References : 83 83 !!--------------------------------------------------------------------- 84 84 INTEGER, INTENT(in) :: kt ! number of iteration … … 93 93 ! 94 94 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 95 ! 96 REAL(wp), POINTER, DIMENSION(:,:) :: zqsr, zqns 95 97 !!------------------------------------------------------------------- 98 CALL wrk_alloc( jpi, jpj, zqsr, zqns ) 99 96 100 IF( nn_timing == 1 ) CALL timing_start('limthd') 97 101 … … 137 141 !-----------------------------------------------------------------------------! 138 142 143 !--- Ocean solar and non solar fluxes to be used in zqld 144 IF ( .NOT. lk_cpl ) THEN ! --- forced case, fluxes to the lead are the same as over the ocean 145 ! 146 zqsr(:,:) = qsr(:,:) ; zqns(:,:) = qns(:,:) 147 ! 148 ELSE ! --- coupled case, fluxes to the lead are total - intercepted 149 ! 150 zqsr(:,:) = qsr_tot(:,:) ; zqns(:,:) = qns_tot(:,:) 151 ! 152 DO jl = 1, jpl 153 DO jj = 1, jpj 154 DO ji = 1, jpi 155 zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * old_a_i(ji,jj,jl) 156 zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * old_a_i(ji,jj,jl) 157 END DO 158 END DO 159 END DO 160 ! 161 ENDIF 162 139 163 !CDIR NOVERRCHK 140 164 DO jj = 1, jpj … … 149 173 ! ! temperature and turbulent mixing (McPhee, 1992) 150 174 ! 175 151 176 ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 152 zqld = tms(ji,jj) * rdt_ice * & 153 & ( pfrld(ji,jj) * ( qsr(ji,jj) * oatte(ji,jj) & ! solar heat + clem modif 154 & + qns(ji,jj) ) & ! non solar heat 155 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 156 & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 177 zqld = tms(ji,jj) * rdt_ice * & 178 & ( pfrld(ji,jj) * ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) ) & 179 & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * & ! heat content of precip 180 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 157 181 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) ) 182 ! REMARK valid at least in forced mode from clem 183 ! precip is included in qns but not in qns_ice 158 184 159 185 !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! … … 185 211 hfx_in(ji,jj) = hfx_in(ji,jj) & 186 212 ! heat flux above the ocean 187 & + pfrld(ji,jj) * ( qns(ji,jj) + qsr(ji,jj) )&213 & + pfrld(ji,jj) * ( zqns(ji,jj) + zqsr(ji,jj) ) & 188 214 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 189 215 & + ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & … … 306 332 CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri , jpi, jpj, npb(1:nbpb) ) 307 333 CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res , jpi, jpj, npb(1:nbpb) ) 308 309 CALL tab_2d_1d( nbpb, iatte_1d (1:nbpb), iatte , jpi, jpj, npb(1:nbpb) )310 CALL tab_2d_1d( nbpb, oatte_1d (1:nbpb), oatte , jpi, jpj, npb(1:nbpb) )311 334 312 335 CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) ) … … 482 505 ENDIF 483 506 ! 507 ! 508 CALL wrk_dealloc( jpi, jpj, zqsr, zqns ) 509 510 ! 484 511 ! conservation test 485 512 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 486 513 ! 487 514 IF( nn_timing == 1 ) CALL timing_stop('limthd') 515 488 516 END SUBROUTINE lim_thd 489 517 … … 552 580 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp ) 553 581 IF(lwm) WRITE ( numoni, namicethd ) 582 583 IF( lk_cpl .AND. parsub /= 0.0 ) CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) 554 584 ! 555 585 IF(lwp) THEN ! control print -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r4900 r4901 26 26 USE wrk_nemo ! work arrays 27 27 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 28 USE cpl_oasis3, ONLY : lk_cpl29 28 30 29 IMPLICIT NONE … … 166 165 ! 167 166 DO ji = kideb, kiut 168 zinda 169 ztmelts 170 171 zfdum = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)172 zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)167 zinda = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) ) ) 168 ztmelts = zinda * rtt + ( 1._wp - zinda ) * rtt 169 170 zfdum = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 171 zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji) 173 172 174 173 zq_su (ji) = MAX( 0._wp, zfdum * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_b(ji) - ztmelts ) ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r4900 r4901 25 25 USE wrk_nemo ! work arrays 26 26 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 27 USE cpl_oasis3, ONLY : lk_cpl27 USE sbc_oce, ONLY : lk_cpl 28 28 29 29 IMPLICIT NONE … … 146 146 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrid ! tridiagonal system terms 147 147 ! diag errors on heat 148 REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini 149 REAL(wp) :: zhfx_err 148 REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx_err 150 149 !!------------------------------------------------------------------ 151 150 ! … … 158 157 CALL wrk_alloc( jpij, jkmax+2, 3, ztrid ) 159 158 160 CALL wrk_alloc( jpij, zdq, zq_ini )159 CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err ) 161 160 162 161 ! --- diag error on heat diffusion - PART 1 --- ! … … 272 271 273 272 DO ji = kideb, kiut ! Radiation transmitted below the ice 274 !!!ftr_ice_1d(ji) = ftr_ice_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif275 273 ftr_ice_1d(ji) = zradtr_i(ji,nlay_i) 276 274 END DO … … 407 405 !------------------------------------------------------------------------------| 408 406 ! 409 DO ji = kideb , kiut 410 ! update of the non solar flux according to the update in T_su 411 qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_b(ji) - ztsuoldit(ji) ) 412 407 IF( .NOT. lk_cpl ) THEN !--- forced atmosphere case 408 DO ji = kideb , kiut 409 ! update of the non solar flux according to the update in T_su 410 qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_b(ji) - ztsuoldit(ji) ) 411 END DO 412 ENDIF 413 414 ! Update incoming flux 415 DO ji = kideb , kiut 413 416 ! update incoming flux 414 417 zf(ji) = zfsw(ji) & ! net absorbed solar radiation 415 + qns_ice_1d(ji) ! non solar total flux418 + qns_ice_1d(ji) ! non solar total flux 416 419 ! (LWup, LWdw, SH, LH) 417 420 END DO … … 737 740 CALL lim_thd_enmelt( kideb, kiut ) 738 741 739 ! --- diag erroron heat diffusion - PART 2 --- !742 ! --- diag conservation imbalance on heat diffusion - PART 2 --- ! 740 743 DO ji = kideb, kiut 741 744 zdq(ji) = - zq_ini(ji) + ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) + & 742 745 & SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 743 zhfx_err = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice ) 744 hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err * a_i_b(ji) 745 ! --- correction of qns_ice and surface conduction flux --- ! 746 qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err 747 fc_su (ji) = fc_su (ji) - zhfx_err 748 ! --- Heat flux at the ice surface in W.m-2 --- ! 746 zhfx_err(ji) = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice ) 747 hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_b(ji) 748 END DO 749 750 ! diagnose external surface (forced case) or bottom (forced case) from heat conservation 751 IF( .NOT. lk_cpl ) THEN ! --- forced case: qns_ice and fc_su are diagnosed 752 ! 753 DO ji = kideb, kiut 754 qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err(ji) 755 fc_su (ji) = fc_su(ji) - zhfx_err(ji) 756 END DO 757 ! 758 ELSE ! --- coupled case: ocean turbulent heat flux is diagnosed 759 ! 760 DO ji = kideb, kiut 761 fhtur_1d (ji) = fhtur_1d(ji) - zhfx_err(ji) 762 END DO 763 ! 764 ENDIF 765 766 ! --- compute diagnostic net heat flux at the surface of the snow-ice system (W.m2) 767 DO ji = kideb, kiut 749 768 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 750 769 hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_b(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) … … 759 778 CALL wrk_dealloc( jpij, jkmax+2, zindterm, zindtbis, zdiagbis ) 760 779 CALL wrk_dealloc( jpij, jkmax+2, 3, ztrid ) 761 CALL wrk_dealloc( jpij, zdq, zq_ini )780 CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err ) 762 781 763 782 END SUBROUTINE lim_thd_dif -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r4900 r4901 29 29 USE lib_mpp ! MPP library 30 30 USE wrk_nemo ! work arrays 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 32 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 32 33 USE limthd_ent … … 133 134 !Energy of melting q(S,T) [J.m-3] 134 135 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes 135 e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i )136 e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i, wp ) 136 137 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 137 138 END DO … … 171 172 zgamafr = 0.03 172 173 173 DO jj = 1, jpj 174 DO ji = 1, jpi 175 174 DO jj = 2, jpj 175 DO ji = 2, jpi 176 176 IF ( qlead(ji,jj) < 0._wp ) THEN 177 177 !------------- … … 243 243 END DO ! loop on ji ends 244 244 END DO ! loop on jj ends 245 ! 246 CALL lbc_lnk( zvrel(:,:), 'T', 1. ) 247 CALL lbc_lnk( hicol(:,:), 'T', 1. ) 245 248 246 249 ENDIF ! End of computation of frazil ice collection thickness … … 255 258 ! This occurs if open water energy budget is negative 256 259 nbpac = 0 260 npac(:) = 0 261 ! 257 262 DO jj = 1, jpj 258 263 DO ji = 1, jpi … … 315 320 ! Keep old ice areas and volume in memory 316 321 !----------------------------------------- 317 zv_old(:,:) = zv_i_1d(:,:) 318 za_old(:,:) = za_i_1d(:,:) 319 322 zv_old(1:nbpac,:) = zv_i_1d(1:nbpac,:) 323 za_old(1:nbpac,:) = za_i_1d(1:nbpac,:) 320 324 !---------------------- 321 325 ! Thickness of new ice … … 324 328 zh_newice(ji) = hiccrit 325 329 END DO 326 IF( fraz_swi == 1 ) zh_newice( :) = hicol_b(:)330 IF( fraz_swi == 1 ) zh_newice(1:nbpac) = hicol_b(1:nbpac) 327 331 328 332 !---------------------- … … 331 335 SELECT CASE ( num_sal ) 332 336 CASE ( 1 ) ! Sice = constant 333 zs_newice( :) = bulk_sal337 zs_newice(1:nbpac) = bulk_sal 334 338 CASE ( 2 ) ! Sice = F(z,t) [Vancoppenolle et al (2005)] 335 339 DO ji = 1, nbpac … … 339 343 END DO 340 344 CASE ( 3 ) ! Sice = F(z) [multiyear ice] 341 zs_newice( :) = 2.3345 zs_newice(1:nbpac) = 2.3 342 346 END SELECT 343 347 … … 472 476 za_i_1d(ji,jl) = zinda * za_i_1d(ji,jl) 473 477 zv_i_1d(ji,jl) = zv_i_1d(ji,jl) + zv_newfra 474 475 478 ! for remapping 476 479 h_i_old (ji,nlay_i+1) = zv_newfra … … 479 482 480 483 ! --- Ice enthalpy remapping --- ! 481 IF( zv_newfra > 0._wp ) THEN 482 CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) ) 483 ENDIF 484 CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) ) 484 485 485 486 ENDDO … … 534 535 DO ji = 1, jpi 535 536 ! heat content in Joules 536 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ) * unit_fac )537 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ,wp ) * unit_fac ) 537 538 END DO 538 539 END DO -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r4900 r4901 115 115 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_i_new !: Salinity of new ice at the bottom 116 116 117 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: iatte_1d !: clem attenuation coef of the input solar flux (unitless)118 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: oatte_1d !: clem attenuation coef of the input solar flux (unitless)119 120 117 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_s_b !: corresponding to the 2D var t_s 121 118 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_i_b !: corresponding to the 2D var t_i … … 149 146 & qsr_ice_1d (jpij) , & 150 147 & fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qns_ice_1d(jpij) , & 151 & t_bo_b (jpij) , iatte_1d (jpij) , oatte_1d (jpij) ,&148 & t_bo_b (jpij) , & 152 149 & hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,hfx_dif_1d(jpij) ,hfx_opw_1d(jpij) , & 153 150 & hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90
r4897 r4901 54 54 USE icbini ! handle bergs, initialisation 55 55 USE icbstp ! handle bergs, calving, themodynamics and transport 56 #if defined key_oasis357 56 USE cpl_oasis3 ! OASIS3 coupling 58 #elif defined key_oasis459 USE cpl_oasis4 ! OASIS4 coupling (not working)60 #endif61 57 USE lib_mpp ! distributed memory computing 62 58 #if defined key_iomput … … 166 162 #if defined key_iomput 167 163 IF( Agrif_Root() ) THEN 168 # if defined key_oasis3 || defined key_oasis4 169 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 170 CALL xios_initialize( "oceanx",local_comm=ilocal_comm ) 171 # else 172 CALL xios_initialize( "nemo",return_comm=ilocal_comm ) 173 # endif 164 IF( lk_cpl ) THEN 165 CALL cpl_init( ilocal_comm ) ! nemo local communicator given by oasis 166 CALL xios_initialize( "oceanx",local_comm=ilocal_comm ) ! send nemo communicator to xios 167 ELSE 168 CALL xios_initialize( "nemo",return_comm=ilocal_comm ) ! nemo local communicator given by xios 169 ENDIF 170 ENDIF 174 171 ENDIF 175 172 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 176 173 #else 177 # if defined key_oasis3 || defined key_oasis4 178 IF( Agrif_Root() ) THEN179 CALL cpl_prism_init( ilocal_comm )! nemo local communicator given by oasis180 ENDIF181 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt)182 # else 183 ilocal_comm = 0184 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt)185 # endif 174 IF( lk_cpl ) THEN 175 IF( Agrif_Root() ) THEN 176 CALL cpl_init( ilocal_comm ) ! nemo local communicator given by oasis 177 ENDIF 178 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 179 ELSE 180 ilocal_comm = 0 181 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt) 182 ENDIF 186 183 #endif 187 184 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90
r4147 r4901 7 7 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 8 8 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 9 !!---------------------------------------------------------------------- 10 #if ! defined key_coupled 11 9 !!---------------------------------------------------------------------- 12 10 !!---------------------------------------------------------------------- 13 11 !! Only for ORCA2 ORCA1 and ORCA025 … … 29 27 30 28 PUBLIC dia_fwb ! routine called by step.F90 31 32 LOGICAL, PUBLIC, PARAMETER :: lk_diafwb = .TRUE. !: fresh water budget flag33 29 34 30 REAL(wp) :: a_fwf , & … … 453 449 END SUBROUTINE dia_fwb 454 450 455 #else456 !!----------------------------------------------------------------------457 !! Default option : Dummy Module458 !!----------------------------------------------------------------------459 LOGICAL, PUBLIC, PARAMETER :: lk_diafwb = .FALSE. !: fresh water budget flag460 CONTAINS461 SUBROUTINE dia_fwb( kt ) ! Empty routine462 WRITE(*,*) 'dia_fwb: : You should not have seen this print! error?', kt463 END SUBROUTINE dia_fwb464 #endif465 466 451 !!====================================================================== 467 452 END MODULE diafwb -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r4896 r4901 488 488 ENDIF 489 489 490 #if ! defined key_coupled 491 CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp 492 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 493 CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping" , "Kg/m2/s", & ! erp 494 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 495 CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping" , "Kg/m2/s", & ! erp * sn 496 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 497 #endif 498 499 500 501 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 ) 502 CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp 503 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 504 CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping" , "Kg/m2/s", & ! erp 505 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 506 CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping" , "Kg/m2/s", & ! erp * sn 507 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 508 #endif 490 IF( .NOT. lk_cpl ) THEN 491 CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp 492 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 493 CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping" , "Kg/m2/s", & ! erp 494 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 495 CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping" , "Kg/m2/s", & ! erp * sn 496 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 497 ENDIF 498 499 IF( lk_cpl .AND. nn_ice <= 1 ) THEN 500 CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp 501 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 502 CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping" , "Kg/m2/s", & ! erp 503 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 504 CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping" , "Kg/m2/s", & ! erp * sn 505 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 506 ENDIF 507 509 508 clmx ="l_max(only(x))" ! max index on a period 510 509 CALL histdef( nid_T, "sobowlin", "Bowl Index" , "W-point", & ! bowl INDEX … … 521 520 #endif 522 521 523 #if defined key_coupled 524 # if defined key_lim3 525 Must be adapted to LIM3 526 # endif 527 # if defined key_lim2 528 CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature" , "K" , & ! tn_ice 529 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 530 CALL histdef( nid_T,"soicealb" , "Ice Albedo" , "[0,1]" , & ! alb_ice 531 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 532 # endif 533 #endif 522 IF( lk_cpl .AND. nn_ice == 2 ) THEN 523 CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature" , "K" , & ! tn_ice 524 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 525 CALL histdef( nid_T,"soicealb" , "Ice Albedo" , "[0,1]" , & ! alb_ice 526 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 527 ENDIF 534 528 535 529 CALL histend( nid_T, snc4chunks=snc4set ) … … 683 677 ENDIF 684 678 685 #if ! defined key_coupled 686 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 687 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping 688 IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 689 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 690 #endif 691 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 ) 692 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 693 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping 679 IF( .NOT. lk_cpl ) THEN 680 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 681 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping 694 682 IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 695 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 696 #endif 683 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 684 ENDIF 685 IF( lk_cpl .AND. nn_ice <= 1 ) THEN 686 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 687 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping 688 IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 689 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 690 ENDIF 697 691 zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1) 698 692 CALL histwrite( nid_T, "sobowlin", it, zw2d , ndim_hT, ndex_hT ) ! ??? … … 705 699 #endif 706 700 707 #if defined key_coupled 708 # if defined key_lim3 709 Must be adapted for LIM3 710 CALL histwrite( nid_T, "soicetem", it, tn_ice , ndim_hT, ndex_hT ) ! surf. ice temperature 711 CALL histwrite( nid_T, "soicealb", it, alb_ice , ndim_hT, ndex_hT ) ! ice albedo 712 # endif 713 # if defined key_lim2 714 CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT ) ! surf. ice temperature 715 CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT ) ! ice albedo 716 # endif 717 #endif 718 ! Write fields on U grid 701 IF( lk_cpl .AND. nn_ice == 2 ) THEN 702 CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT ) ! surf. ice temperature 703 CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT ) ! ice albedo 704 ENDIF 705 706 ! Write fields on U grid 719 707 CALL histwrite( nid_U, "vozocrtx", it, un , ndim_U , ndex_U ) ! i-current 720 708 IF( ln_traldf_gdia ) THEN -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r4900 r4901 134 134 #endif 135 135 IF( lk_lim3 ) THEN 136 CALL iom_rstput( kt, nitrst, numrow, 'iatte' , iatte ) !clem modif 137 CALL iom_rstput( kt, nitrst, numrow, 'oatte' , oatte ) !clem modif 136 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev' , fraqsr_1lev ) !clem modif 138 137 ENDIF 139 138 IF( kt == nitrst ) THEN … … 258 257 ! 259 258 IF( lk_lim3 ) THEN 260 CALL iom_get( numror, jpdom_autoglo, 'iatte' , iatte ) ! clem modif 261 CALL iom_get( numror, jpdom_autoglo, 'oatte' , oatte ) ! clem modif 259 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 262 260 ENDIF 263 261 ! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r3294 r4901 2 2 !!====================================================================== 3 3 !! *** MODULE cpl_oasis *** 4 !! Coupled O/A : coupled ocean-atmosphere case using OASIS3 V. prism_2_4 5 !! special case: NEMO OPA/LIM coupled to ECHAM5 4 !! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT 6 5 !!===================================================================== 7 6 !! History : … … 15 14 !! 3.4 ! 11-11 (C. Harris) Changes to allow mutiple category fields 16 15 !!---------------------------------------------------------------------- 16 !!---------------------------------------------------------------------- 17 !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3 18 !!---------------------------------------------------------------------- 19 !! cpl_init : initialization of coupled mode communication 20 !! cpl_define : definition of grid and fields 21 !! cpl_snd : snd out fields in coupled mode 22 !! cpl_rcv : receive fields in coupled mode 23 !! cpl_finalize : finalize the coupled mode communication 24 !!---------------------------------------------------------------------- 17 25 #if defined key_oasis3 18 !!---------------------------------------------------------------------- 19 !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3 20 !!---------------------------------------------------------------------- 21 !! cpl_prism_init : initialization of coupled mode communication 22 !! cpl_prism_define : definition of grid and fields 23 !! cpl_prism_snd : snd out fields in coupled mode 24 !! cpl_prism_rcv : receive fields in coupled mode 25 !! cpl_prism_finalize : finalize the coupled mode communication 26 !!---------------------------------------------------------------------- 27 USE mod_prism_proto ! OASIS3 prism module 28 USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning 29 USE mod_prism_put_proto ! OASIS3 prism module for snding 30 USE mod_prism_get_proto ! OASIS3 prism module for receiving 31 USE mod_comprism_proto ! OASIS3 prism module to get coupling frequency 26 USE mod_oasis ! OASIS3-MCT module 27 #endif 32 28 USE par_oce ! ocean parameters 33 29 USE dom_oce ! ocean space and time domain … … 38 34 PRIVATE 39 35 40 PUBLIC cpl_prism_init 41 PUBLIC cpl_prism_define 42 PUBLIC cpl_prism_snd 43 PUBLIC cpl_prism_rcv 44 PUBLIC cpl_prism_freq 45 PUBLIC cpl_prism_finalize 46 47 LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE. !: coupled flag 36 PUBLIC cpl_init 37 PUBLIC cpl_define 38 PUBLIC cpl_snd 39 PUBLIC cpl_rcv 40 PUBLIC cpl_freq 41 PUBLIC cpl_finalize 42 48 43 INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field 49 44 INTEGER, PUBLIC :: OASIS_idle = 0 !: return code if nothing done by oasis 50 INTEGER :: ncomp_id ! id returned by prism_init_comp45 INTEGER :: ncomp_id ! id returned by oasis_init_comp 51 46 INTEGER :: nerror ! return error code 52 53 INTEGER, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields 47 #if ! defined key_oasis3 48 ! OASIS Variables not used. defined only for compilation purpose 49 INTEGER :: OASIS_Out = -1 50 INTEGER :: OASIS_REAL = -1 51 INTEGER :: OASIS_Ok = -1 52 INTEGER :: OASIS_In = -1 53 INTEGER :: OASIS_Sent = -1 54 INTEGER :: OASIS_SentOut = -1 55 INTEGER :: OASIS_ToRest = -1 56 INTEGER :: OASIS_ToRestOut = -1 57 INTEGER :: OASIS_Recvd = -1 58 INTEGER :: OASIS_RecvOut = -1 59 INTEGER :: OASIS_FromRest = -1 60 INTEGER :: OASIS_FromRestOut = -1 61 #endif 62 63 INTEGER, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields 64 INTEGER, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 65 INTEGER, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields 54 66 55 67 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information … … 58 70 CHARACTER(len = 1) :: clgrid ! Grid type 59 71 REAL(wp) :: nsgn ! Control of the sign change 60 INTEGER, DIMENSION( 9) :: nid ! Id of the field (no more than 9 categories)72 INTEGER, DIMENSION(nmaxcat,nmaxcpl) :: nid ! Id of the field (no more than 9 categories and 9 extrena models) 61 73 INTEGER :: nct ! Number of categories in field 74 INTEGER :: ncplmodel ! Maximum number of models to/from which this variable may be sent/received 62 75 END TYPE FLD_CPL 63 76 … … 73 86 CONTAINS 74 87 75 SUBROUTINE cpl_ prism_init( kl_comm )88 SUBROUTINE cpl_init( kl_comm ) 76 89 !!------------------------------------------------------------------- 77 !! *** ROUTINE cpl_ prism_init ***90 !! *** ROUTINE cpl_init *** 78 91 !! 79 92 !! ** Purpose : Initialize coupled mode communication for ocean … … 89 102 90 103 !------------------------------------------------------------------ 91 ! 1st Initialize the PRISMsystem for the application104 ! 1st Initialize the OASIS system for the application 92 105 !------------------------------------------------------------------ 93 CALL prism_init_comp_proto( ncomp_id, 'oceanx', nerror )94 IF ( nerror /= PRISM_Ok ) &95 CALL prism_abort_proto (ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto')106 CALL oasis_init_comp ( ncomp_id, 'oceanx', nerror ) 107 IF ( nerror /= OASIS_Ok ) & 108 CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') 96 109 97 110 !------------------------------------------------------------------ … … 99 112 !------------------------------------------------------------------ 100 113 101 CALL prism_get_localcomm_proto( kl_comm, nerror )102 IF ( nerror /= PRISM_Ok ) &103 CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' )104 ! 105 END SUBROUTINE cpl_ prism_init106 107 108 SUBROUTINE cpl_ prism_define( krcv, ksnd)114 CALL oasis_get_localcomm ( kl_comm, nerror ) 115 IF ( nerror /= OASIS_Ok ) & 116 CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 117 ! 118 END SUBROUTINE cpl_init 119 120 121 SUBROUTINE cpl_define( krcv, ksnd, kcplmodel ) 109 122 !!------------------------------------------------------------------- 110 !! *** ROUTINE cpl_ prism_define ***123 !! *** ROUTINE cpl_define *** 111 124 !! 112 125 !! ** Purpose : Define grid and field information for ocean … … 116 129 !!-------------------------------------------------------------------- 117 130 INTEGER, INTENT(in) :: krcv, ksnd ! Number of received and sent coupling fields 131 INTEGER, INTENT(in) :: kcplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 118 132 ! 119 133 INTEGER :: id_part 120 134 INTEGER :: paral(5) ! OASIS3 box partition 121 135 INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe 122 INTEGER :: ji,jc ! local loop indicees 123 CHARACTER(LEN=8) :: zclname 136 INTEGER :: ji,jc,jm ! local loop indicees 137 CHARACTER(LEN=64) :: zclname 138 CHARACTER(LEN=2) :: cli2 124 139 !!-------------------------------------------------------------------- 125 140 126 141 IF(lwp) WRITE(numout,*) 127 IF(lwp) WRITE(numout,*) 'cpl_ prism_define : initialization in coupled ocean/atmosphere case'142 IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case' 128 143 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 129 144 IF(lwp) WRITE(numout,*) 130 145 146 IF( kcplmodel > nmaxcpl ) THEN 147 CALL oasis_abort ( ncomp_id, 'cpl_define', 'kcplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN 148 ENDIF 131 149 ! 132 150 ! ... Define the shape for the area that excludes the halo … … 141 159 ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror) 142 160 IF( nerror > 0 ) THEN 143 CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld') ; RETURN161 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN 144 162 ENDIF 145 163 ! … … 161 179 ENDIF 162 180 163 CALL prism_def_partition_proto( id_part, paral, nerror )181 CALL oasis_def_partition ( id_part, paral, nerror ) 164 182 ! 165 183 ! ... Announce send variables. 166 184 ! 185 ssnd(:)%ncplmodel = kcplmodel 186 ! 167 187 DO ji = 1, ksnd 168 IF ( ssnd(ji)%laction ) THEN 188 IF ( ssnd(ji)%laction ) THEN 189 190 IF( ssnd(ji)%nct > nmaxcat ) THEN 191 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// & 192 & TRIM(ssnd(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 193 RETURN 194 ENDIF 195 169 196 DO jc = 1, ssnd(ji)%nct 170 IF ( ssnd(ji)%nct .gt. 1 ) THEN 171 WRITE(zclname,'( a7, i1)') ssnd(ji)%clname,jc 172 ELSE 173 zclname=ssnd(ji)%clname 174 ENDIF 175 WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_Out 176 CALL prism_def_var_proto (ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/), & 177 PRISM_Out, ishape, PRISM_REAL, nerror) 178 IF ( nerror /= PRISM_Ok ) THEN 179 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 180 CALL prism_abort_proto ( ssnd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 181 ENDIF 197 DO jm = 1, kcplmodel 198 199 IF ( ssnd(ji)%nct .GT. 1 ) THEN 200 WRITE(cli2,'(i2.2)') jc 201 zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2 202 ELSE 203 zclname = ssnd(ji)%clname 204 ENDIF 205 IF ( kcplmodel > 1 ) THEN 206 WRITE(cli2,'(i2.2)') jm 207 zclname = 'model'//cli2//'_'//TRIM(zclname) 208 ENDIF 209 #if defined key_agrif 210 IF( agrif_fixed() /= 0 ) THEN 211 zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 212 END IF 213 #endif 214 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out 215 CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 216 & OASIS_Out , ishape , OASIS_REAL, nerror ) 217 IF ( nerror /= OASIS_Ok ) THEN 218 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 219 CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 220 ENDIF 221 IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 222 IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 223 END DO 182 224 END DO 183 225 ENDIF … … 188 230 DO ji = 1, krcv 189 231 IF ( srcv(ji)%laction ) THEN 232 233 IF( srcv(ji)%nct > nmaxcat ) THEN 234 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// & 235 & TRIM(srcv(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 236 RETURN 237 ENDIF 238 190 239 DO jc = 1, srcv(ji)%nct 191 IF ( srcv(ji)%nct .gt. 1 ) THEN 192 WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc 193 ELSE 194 zclname=srcv(ji)%clname 195 ENDIF 196 WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In 197 CALL prism_def_var_proto ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/), & 198 & PRISM_In , ishape , PRISM_REAL, nerror) 199 IF ( nerror /= PRISM_Ok ) THEN 200 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 201 CALL prism_abort_proto ( srcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 202 ENDIF 240 DO jm = 1, kcplmodel 241 242 IF ( srcv(ji)%nct .GT. 1 ) THEN 243 WRITE(cli2,'(i2.2)') jc 244 zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2 245 ELSE 246 zclname = srcv(ji)%clname 247 ENDIF 248 IF ( kcplmodel > 1 ) THEN 249 WRITE(cli2,'(i2.2)') jm 250 zclname = 'model'//cli2//'_'//TRIM(zclname) 251 ENDIF 252 #if defined key_agrif 253 IF( agrif_fixed() /= 0 ) THEN 254 zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 255 END IF 256 #endif 257 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 258 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 259 & OASIS_In , ishape , OASIS_REAL, nerror ) 260 IF ( nerror /= OASIS_Ok ) THEN 261 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 262 CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 263 ENDIF 264 IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 265 IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 266 267 END DO 203 268 END DO 204 269 ENDIF … … 209 274 !------------------------------------------------------------------ 210 275 211 CALL prism_enddef_proto(nerror)212 IF( nerror /= PRISM_Ok ) CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef')213 ! 214 END SUBROUTINE cpl_ prism_define276 CALL oasis_enddef(nerror) 277 IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 278 ! 279 END SUBROUTINE cpl_define 215 280 216 281 217 SUBROUTINE cpl_ prism_snd( kid, kstep, pdata, kinfo )282 SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo ) 218 283 !!--------------------------------------------------------------------- 219 !! *** ROUTINE cpl_ prism_snd ***284 !! *** ROUTINE cpl_snd *** 220 285 !! 221 286 !! ** Purpose : - At each coupling time-step,this routine sends fields … … 227 292 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdata 228 293 !! 229 INTEGER :: jc 294 INTEGER :: jc,jm ! local loop index 230 295 !!-------------------------------------------------------------------- 231 296 ! … … 233 298 ! 234 299 DO jc = 1, ssnd(kid)%nct 235 236 CALL prism_put_proto ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 237 238 IF ( ln_ctl ) THEN 239 IF ( kinfo == PRISM_Sent .OR. kinfo == PRISM_ToRest .OR. & 240 & kinfo == PRISM_SentOut .OR. kinfo == PRISM_ToRestOut ) THEN 241 WRITE(numout,*) '****************' 242 WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 243 WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid(jc) 244 WRITE(numout,*) 'prism_put_proto: kstep ', kstep 245 WRITE(numout,*) 'prism_put_proto: info ', kinfo 246 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 247 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 248 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 249 WRITE(numout,*) '****************' 300 DO jm = 1, ssnd(kid)%ncplmodel 301 302 IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN 303 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 304 305 IF ( ln_ctl ) THEN 306 IF ( kinfo == OASIS_Sent .OR. kinfo == OASIS_ToRest .OR. & 307 & kinfo == OASIS_SentOut .OR. kinfo == OASIS_ToRestOut ) THEN 308 WRITE(numout,*) '****************' 309 WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname 310 WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc,jm) 311 WRITE(numout,*) 'oasis_put: kstep ', kstep 312 WRITE(numout,*) 'oasis_put: info ', kinfo 313 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 314 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 315 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 316 WRITE(numout,*) '****************' 317 ENDIF 318 ENDIF 319 250 320 ENDIF 251 ENDIF252 321 322 ENDDO 253 323 ENDDO 254 324 ! 255 END SUBROUTINE cpl_ prism_snd256 257 258 SUBROUTINE cpl_ prism_rcv( kid, kstep, pdata, kinfo )325 END SUBROUTINE cpl_snd 326 327 328 SUBROUTINE cpl_rcv( kid, kstep, pdata, pmask, kinfo ) 259 329 !!--------------------------------------------------------------------- 260 !! *** ROUTINE cpl_ prism_rcv ***330 !! *** ROUTINE cpl_rcv *** 261 331 !! 262 332 !! ** Purpose : - At each coupling time-step,this routine receives fields … … 266 336 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 267 337 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdata ! IN to keep the value if nothing is done 338 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pmask ! coupling mask 268 339 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 269 340 !! 270 INTEGER :: jc 271 LOGICAL :: llaction 341 INTEGER :: jc,jm ! local loop index 342 LOGICAL :: llaction, llfisrt 272 343 !!-------------------------------------------------------------------- 273 344 ! 274 345 ! receive local data from OASIS3 on every process 275 346 ! 347 kinfo = OASIS_idle 348 ! 276 349 DO jc = 1, srcv(kid)%nct 277 278 CALL prism_get_proto ( srcv(kid)%nid(jc), kstep, exfld, kinfo ) 279 280 llaction = .false. 281 IF( kinfo == PRISM_Recvd .OR. kinfo == PRISM_FromRest .OR. & 282 kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut ) llaction = .TRUE. 283 284 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc) 285 286 IF ( llaction ) THEN 287 288 kinfo = OASIS_Rcv 289 pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 290 291 !--- Fill the overlap areas and extra hallows (mpp) 292 !--- check periodicity conditions (all cases) 293 CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 294 295 IF ( ln_ctl ) THEN 296 WRITE(numout,*) '****************' 297 WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 298 WRITE(numout,*) 'prism_get_proto: ivarid ' , srcv(kid)%nid(jc) 299 WRITE(numout,*) 'prism_get_proto: kstep', kstep 300 WRITE(numout,*) 'prism_get_proto: info ', kinfo 301 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 302 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 303 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 304 WRITE(numout,*) '****************' 350 llfisrt = .TRUE. 351 352 DO jm = 1, srcv(kid)%ncplmodel 353 354 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 355 356 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 357 358 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 359 & kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 360 361 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 362 363 IF ( llaction ) THEN 364 365 kinfo = OASIS_Rcv 366 IF( llfisrt ) THEN 367 pdata(nldi:nlei,nldj:nlej,jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 368 llfisrt = .FALSE. 369 ELSE 370 pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 371 ENDIF 372 373 IF ( ln_ctl ) THEN 374 WRITE(numout,*) '****************' 375 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 376 WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc,jm) 377 WRITE(numout,*) 'oasis_get: kstep', kstep 378 WRITE(numout,*) 'oasis_get: info ', kinfo 379 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 380 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 381 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 382 WRITE(numout,*) '****************' 383 ENDIF 384 385 ENDIF 386 305 387 ENDIF 306 388 307 ELSE 308 kinfo = OASIS_idle 309 ENDIF 310 389 ENDDO 390 391 !--- Fill the overlap areas and extra hallows (mpp) 392 !--- check periodicity conditions (all cases) 393 IF( .not. llfisrt ) CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 394 311 395 ENDDO 312 396 ! 313 END SUBROUTINE cpl_ prism_rcv314 315 316 INTEGER FUNCTION cpl_ prism_freq( kid )397 END SUBROUTINE cpl_rcv 398 399 400 INTEGER FUNCTION cpl_freq( kid ) 317 401 !!--------------------------------------------------------------------- 318 !! *** ROUTINE cpl_ prism_freq ***402 !! *** ROUTINE cpl_freq *** 319 403 !! 320 404 !! ** Purpose : - send back the coupling frequency for a particular field 321 405 !!---------------------------------------------------------------------- 322 INTEGER,INTENT(in) :: kid ! variable index 406 INTEGER,INTENT(in) :: kid ! variable index 407 !! 408 INTEGER :: info 323 409 !!---------------------------------------------------------------------- 324 cpl_prism_freq = ig_def_freq( kid)325 ! 326 END FUNCTION cpl_ prism_freq327 328 329 SUBROUTINE cpl_ prism_finalize410 CALL oasis_get_freqs(kid, 1, cpl_freq, info) 411 ! 412 END FUNCTION cpl_freq 413 414 415 SUBROUTINE cpl_finalize 330 416 !!--------------------------------------------------------------------- 331 !! *** ROUTINE cpl_ prism_finalize ***417 !! *** ROUTINE cpl_finalize *** 332 418 !! 333 419 !! ** Purpose : - Finalizes the coupling. If MPI_init has not been 334 !! called explicitly before cpl_ prism_init it will also close420 !! called explicitly before cpl_init it will also close 335 421 !! MPI communication. 336 422 !!---------------------------------------------------------------------- 337 423 ! 338 424 DEALLOCATE( exfld ) 339 CALL prism_terminate_proto( nerror ) 340 ! 341 END SUBROUTINE cpl_prism_finalize 342 343 #else 344 !!---------------------------------------------------------------------- 345 !! Default case Dummy module Forced Ocean/Atmosphere 346 !!---------------------------------------------------------------------- 347 USE in_out_manager ! I/O manager 348 LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE. !: coupled flag 349 PUBLIC cpl_prism_init 350 PUBLIC cpl_prism_finalize 351 CONTAINS 352 SUBROUTINE cpl_prism_init (kl_comm) 353 INTEGER, INTENT(out) :: kl_comm ! local communicator of the model 354 kl_comm = -1 355 WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...' 356 END SUBROUTINE cpl_prism_init 357 SUBROUTINE cpl_prism_finalize 358 WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...' 359 END SUBROUTINE cpl_prism_finalize 425 IF (nstop == 0) THEN 426 CALL oasis_terminate( nerror ) 427 ELSE 428 CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" ) 429 ENDIF 430 ! 431 END SUBROUTINE cpl_finalize 432 433 #if ! defined key_oasis3 434 435 !!---------------------------------------------------------------------- 436 !! No OASIS Library OASIS3 Dummy module... 437 !!---------------------------------------------------------------------- 438 439 SUBROUTINE oasis_init_comp(k1,cd1,k2) 440 CHARACTER(*), INTENT(in ) :: cd1 441 INTEGER , INTENT( out) :: k1,k2 442 k1 = -1 ; k2 = -1 443 WRITE(numout,*) 'oasis_init_comp: Error you sould not be there...', cd1 444 END SUBROUTINE oasis_init_comp 445 446 SUBROUTINE oasis_abort(k1,cd1,cd2) 447 INTEGER , INTENT(in ) :: k1 448 CHARACTER(*), INTENT(in ) :: cd1,cd2 449 WRITE(numout,*) 'oasis_abort: Error you sould not be there...', cd1, cd2 450 END SUBROUTINE oasis_abort 451 452 SUBROUTINE oasis_get_localcomm(k1,k2) 453 INTEGER , INTENT( out) :: k1,k2 454 k1 = -1 ; k2 = -1 455 WRITE(numout,*) 'oasis_get_localcomm: Error you sould not be there...' 456 END SUBROUTINE oasis_get_localcomm 457 458 SUBROUTINE oasis_def_partition(k1,k2,k3) 459 INTEGER , INTENT( out) :: k1,k3 460 INTEGER , INTENT(in ) :: k2(5) 461 k1 = k2(1) ; k3 = k2(5) 462 WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...' 463 END SUBROUTINE oasis_def_partition 464 465 SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7) 466 CHARACTER(*), INTENT(in ) :: cd1 467 INTEGER , INTENT(in ) :: k2,k3(2),k4,k5(2,2),k6 468 INTEGER , INTENT( out) :: k1,k7 469 k1 = -1 ; k7 = -1 470 WRITE(numout,*) 'oasis_def_var: Error you sould not be there...', cd1 471 END SUBROUTINE oasis_def_var 472 473 SUBROUTINE oasis_enddef(k1) 474 INTEGER , INTENT( out) :: k1 475 k1 = -1 476 WRITE(numout,*) 'oasis_enddef: Error you sould not be there...' 477 END SUBROUTINE oasis_enddef 478 479 SUBROUTINE oasis_put(k1,k2,p1,k3) 480 REAL(wp), DIMENSION(:,:), INTENT(in ) :: p1 481 INTEGER , INTENT(in ) :: k1,k2 482 INTEGER , INTENT( out) :: k3 483 k3 = -1 484 WRITE(numout,*) 'oasis_put: Error you sould not be there...' 485 END SUBROUTINE oasis_put 486 487 SUBROUTINE oasis_get(k1,k2,p1,k3) 488 REAL(wp), DIMENSION(:,:), INTENT( out) :: p1 489 INTEGER , INTENT(in ) :: k1,k2 490 INTEGER , INTENT( out) :: k3 491 p1(1,1) = -1. ; k3 = -1 492 WRITE(numout,*) 'oasis_get: Error you sould not be there...' 493 END SUBROUTINE oasis_get 494 495 SUBROUTINE oasis_get_freqs(k1,k2,k3,k4) 496 INTEGER , INTENT(in ) :: k1,k2 497 INTEGER , INTENT( out) :: k3,k4 498 k3 = k1 ; k4 = k2 499 WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...' 500 END SUBROUTINE oasis_get_freqs 501 502 SUBROUTINE oasis_terminate(k1) 503 INTEGER , INTENT( out) :: k1 504 k1 = -1 505 WRITE(numout,*) 'oasis_terminate: Error you sould not be there...' 506 END SUBROUTINE oasis_terminate 507 360 508 #endif 361 509 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r4306 r4901 14 14 !!---------------------------------------------------------------------- 15 15 USE par_oce ! ocean parameters 16 USE sbc_oce ! surface boundary condition: ocean 16 17 # if defined key_lim3 17 18 USE par_ice ! LIM-3 parameters … … 56 57 57 58 #if defined key_lim3 || defined key_lim2 58 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qns_ice !: non solar heat flux over ice [W/m2] 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice !: solar heat flux over ice [W/m2] 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice_mean !: dauly mean solar heat flux over ice [W/m2] 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qla_ice !: latent flux over ice [W/m2] 62 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqla_ice !: latent sensibility over ice [W/m2/K] 63 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqns_ice !: non solar heat flux over ice (LW+SEN+LA) [W/m2/K] 64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice !: ice surface temperature [K] 65 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: alb_ice !: albedo of ice 66 67 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_ice !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts [N/m2] 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtau_ice !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts [N/m2] 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr1_i0 !: 1st Qsr fraction penetrating inside ice cover [-] 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr2_i0 !: 2nd Qsr fraction penetrating inside ice cover [-] 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation-snow budget over ice [kg/m2] 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qns_ice !: non solar heat flux over ice [W/m2] 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice !: solar heat flux over ice [W/m2] 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice_mean !: daily mean solar heat flux over ice [W/m2] 62 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qla_ice !: latent flux over ice [W/m2] 63 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqla_ice !: latent sensibility over ice [W/m2/K] 64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqns_ice !: non solar heat flux over ice (LW+SEN+LA) [W/m2/K] 65 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice !: ice surface temperature [K] 66 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: alb_ice !: ice albedo [-] 67 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_ice !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts [N/m2] 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtau_ice !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts [N/m2] 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr1_i0 !: Solar surface transmission parameter, thick ice [-] 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr2_i0 !: Solar surface transmission parameter, thin ice [-] 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation - precip over sea ice [kg/m2] 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qemp_ice !: heat associated with emp over sea ice [W/m2] 72 74 73 75 # if defined key_lim3 74 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tatm_ice !: air temperature76 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tatm_ice !: air temperature [K] 75 77 # endif 76 78 … … 98 100 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt !: category topmelt 99 101 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: botmelt !: category botmelt 100 #endif 102 103 ! variables used in the coupled interface 104 INTEGER , PUBLIC, PARAMETER :: jpl = ncat 105 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice, alb_ice, qns_ice, dqns_ice ! (jpi,jpj,jpl) 107 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice 108 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice 109 #endif 110 111 #if defined key_lim2 112 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i 113 #endif 114 115 #if ! defined key_lim3 116 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i, ht_s 117 #endif 118 119 #if ! defined key_cice 120 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt, botmelt 121 #endif 122 123 REAL(wp), PUBLIC, SAVE :: cldf_ice = 0.81 !: cloud fraction over sea ice, summer CLIO value [-] 101 124 102 125 !!---------------------------------------------------------------------- … … 111 134 !! *** FUNCTION sbc_ice_alloc *** 112 135 !!---------------------------------------------------------------------- 113 INTEGER :: ierr( 2)136 INTEGER :: ierr(5) 114 137 !!---------------------------------------------------------------------- 115 138 ierr(:) = 0 … … 123 146 & fr1_i0 (jpi,jpj) , fr2_i0 (jpi,jpj) , & 124 147 #if defined key_lim3 125 & emp_ice(jpi,jpj) , tatm_ice(jpi,jpj) , STAT= ierr(1) ) 126 #else 127 & emp_ice(jpi,jpj) , STAT= ierr(1) ) 128 #endif 148 & tatm_ice(jpi,jpj) , & 149 #endif 150 & emp_ice(jpi,jpj) , qemp_ice(jpi,jpj) , STAT= ierr(1) ) 129 151 #elif defined key_cice 130 152 ALLOCATE( qla_ice(jpi,jpj,1) , qlw_ice(jpi,jpj,1) , qsr_ice(jpi,jpj,1) , & … … 132 154 wndj_ice(jpi,jpj) , nfrzmlt(jpi,jpj) , ss_iou(jpi,jpj) , & 133 155 ss_iov(jpi,jpj) , fr_iu(jpi,jpj) , fr_iv(jpi,jpj) , & 134 a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat), STAT= ierr(1) ) 156 a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 157 STAT= ierr(1) ) 158 IF( lk_cpl ) ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , & 159 & v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1) , & 160 & emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , & 161 & STAT= ierr(2) ) 162 135 163 #endif 136 164 ! 137 165 #if defined key_lim2 138 IF( ltrcdm2dc_ice )THEN 139 ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(2) ) 140 ENDIF 166 IF( ltrcdm2dc_ice ) ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(3) ) 141 167 #endif 142 168 ! 169 #if defined key_lim2 170 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(4) ) 171 #endif 172 173 #if defined key_cice || defined key_lim2 174 IF( lk_cpl ) ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 175 #endif 176 143 177 sbc_ice_alloc = MAXVAL( ierr ) 144 178 IF( lk_mpp ) CALL mpp_sum ( sbc_ice_alloc ) … … 150 184 !! Default option NO LIM 2.0 or 3.0 or CICE sea-ice model 151 185 !!---------------------------------------------------------------------- 186 USE in_out_manager ! I/O manager 152 187 LOGICAL , PUBLIC, PARAMETER :: lk_lim2 = .FALSE. !: no LIM-2 ice model 153 188 LOGICAL , PUBLIC, PARAMETER :: lk_lim3 = .FALSE. !: no LIM-3 ice model 154 189 LOGICAL , PUBLIC, PARAMETER :: lk_cice = .FALSE. !: no CICE ice model 155 190 CHARACTER(len=1), PUBLIC, PARAMETER :: cp_ice_msh = '-' !: no grid ice-velocity 191 REAL , PUBLIC, PARAMETER :: cldf_ice = 0.81 !: cloud fraction over sea ice, summer CLIO value [-] 192 INTEGER , PUBLIC, PARAMETER :: jpl = 1 193 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 194 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice, alb_ice, qns_ice, dqns_ice ! (jpi,jpj,jpl) 195 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i 196 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice 197 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice 198 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i, ht_s 199 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt, botmelt 156 200 #endif 157 201 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r4306 r4901 35 35 LOGICAL , PUBLIC :: ln_blk_core !: CORE bulk formulation 36 36 LOGICAL , PUBLIC :: ln_blk_mfs !: MFS bulk formulation 37 LOGICAL , PUBLIC :: ln_cpl !: coupled formulation (overwritten by key_sbc_coupled ) 37 #if defined key_oasis3 38 LOGICAL , PUBLIC :: lk_cpl = .TRUE. !: coupled formulation 39 #else 40 LOGICAL , PUBLIC :: lk_cpl = .FALSE. !: coupled formulation 41 #endif 38 42 LOGICAL , PUBLIC :: ln_dm2dc !: Daily mean to Diurnal Cycle short wave (qsr) 39 43 LOGICAL , PUBLIC :: ln_rnf !: runoffs / runoff mouths … … 45 49 ! !: =1 levitating ice with mass and salt exchange but no presure effect 46 50 ! !: =2 embedded sea-ice (full salt and mass exchanges and pressure) 51 INTEGER , PUBLIC :: nn_limflx !: LIM3 Multi-category heat flux formulation 52 ! !: =-1 Use of per-category fluxes 53 ! !: = 0 Average per-category fluxes 54 ! !: = 1 Average then redistribute per-category fluxes 55 ! !: = 2 Redistribute a single flux over categories 47 56 INTEGER , PUBLIC :: nn_fwb !: FreshWater Budget: 48 57 ! !: = 0 unchecked … … 55 64 LOGICAL , PUBLIC :: ln_icebergs !: Icebergs 56 65 ! 57 CHARACTER (len=8), PUBLIC :: cn_iceflx !: Flux handling over ice categories 58 LOGICAL, PUBLIC :: ln_iceflx_ave ! Average heat fluxes over all ice categories 59 LOGICAL, PUBLIC :: ln_iceflx_linear ! Redistribute mean heat fluxes over all ice categories, using ice temperature and albedo 60 ! 61 INTEGER , PUBLIC :: nn_lsm !: Number of iteration if seaoverland is applied 66 INTEGER , PUBLIC :: nn_lsm !: Number of iteration if seaoverland is applied 67 !!---------------------------------------------------------------------- 68 !! switch definition (improve readability) 69 !!---------------------------------------------------------------------- 70 INTEGER , PUBLIC, PARAMETER :: jp_gyre = 0 !: GYRE analytical formulation 71 INTEGER , PUBLIC, PARAMETER :: jp_ana = 1 !: analytical formulation 72 INTEGER , PUBLIC, PARAMETER :: jp_flx = 2 !: flux formulation 73 INTEGER , PUBLIC, PARAMETER :: jp_clio = 3 !: CLIO bulk formulation 74 INTEGER , PUBLIC, PARAMETER :: jp_core = 4 !: CORE bulk formulation 75 INTEGER , PUBLIC, PARAMETER :: jp_cpl = 5 !: Coupled formulation 76 INTEGER , PUBLIC, PARAMETER :: jp_mfs = 6 !: MFS bulk formulation 77 INTEGER , PUBLIC, PARAMETER :: jp_esopa = -1 !: esopa test, ALL formulations 78 62 79 !!---------------------------------------------------------------------- 63 80 !! Ocean Surface Boundary Condition fields -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r4897 r4901 114 114 !! - utau, vtau i- and j-component of the wind stress 115 115 !! - taum wind stress module at T-point 116 !! - wndm 10m wind module at T-point 116 !! - wndm 10m wind module at T-point over free ocean or leads in presence of sea-ice 117 117 !! - qns non-solar heat flux including latent heat of solid 118 118 !! precip. melting and emp heat content … … 204 204 !! - utau, vtau i- and j-component of the wind stress 205 205 !! - taum wind stress module at T-point 206 !! - wndm 10m wind module at T-point 206 !! - wndm 10m wind module at T-point over free ocean or leads in presence of sea-ice 207 207 !! - qns non-solar heat flux including latent heat of solid 208 208 !! precip. melting and emp heat content … … 398 398 399 399 400 SUBROUTINE blk_ice_clio( pst , palb_cs, palb_os ,&400 SUBROUTINE blk_ice_clio( pst , palb_cs, palb_os, palb, & 401 401 & p_taui, p_tauj, p_qns , p_qsr, & 402 402 & p_qla , p_dqns, p_dqla, & … … 427 427 !!---------------------------------------------------------------------- 428 428 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pst ! ice surface temperature [Kelvin] 429 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_cs ! ice albedo (clear sky) (alb_ice_cs) [%] 430 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_os ! ice albedo (overcast sky) (alb_ice_os) [%] 429 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_cs ! ice albedo (clear sky) (alb_ice_cs) [-] 430 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_os ! ice albedo (overcast sky) (alb_ice_os) [-] 431 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb ! ice albedo (actual value) [-] 431 432 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_taui ! surface ice stress at I-point (i-component) [N/m2] 432 433 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tauj ! surface ice stress at I-point (j-component) [N/m2] … … 438 439 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tpr ! total precipitation (T-point) [Kg/m2/s] 439 440 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_spr ! solid precipitation (T-point) [Kg/m2/s] 440 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr1 ! 1sr fraction of qsr penetration in ice [ %]441 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr2 ! 2nd fraction of qsr penetration in ice [ %]441 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr1 ! 1sr fraction of qsr penetration in ice [-] 442 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr2 ! 2nd fraction of qsr penetration in ice [-] 442 443 CHARACTER(len=1), INTENT(in ) :: cd_grid ! type of sea-ice grid ("C" or "B" grid) 443 444 INTEGER, INTENT(in ) :: pdim ! number of ice categories … … 542 543 !-----------------------------------------------------------! 543 544 CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr ) 545 546 DO jl = 1, ijpl 547 palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) & 548 & + palb_os(:,:,jl) * sf(jp_ccov)%fnow(ji,jj,1) ) 549 END DO 544 550 545 551 ! ! ========================== ! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r4898 r4901 44 44 USE prtctl ! Print control 45 45 USE sbcwave, ONLY : cdn_wave ! wave module 46 #if defined key_lim3 || defined key_cice47 46 USE sbc_ice ! Surface boundary condition: ice fields 48 #endif49 47 USE lib_fortran ! to use key_nosignedzero 50 48 … … 121 119 !! ** Action : defined at each time-step at the air-sea interface 122 120 !! - utau, vtau i- and j-component of the wind stress 123 !! - taum, wndm wind stress and 10m wind modules at T-point 121 !! - taum wind stress module at T-point 122 !! - wndm wind speed module at T-point over free ocean or leads in presence of sea-ice 124 123 !! - qns, qsr non-solar and solar heat fluxes 125 124 !! - emp upward mass flux (evapo. - precip.) … … 232 231 !! - qsr : Solar heat flux over the ocean (W/m2) 233 232 !! - qns : Non Solar heat flux over the ocean (W/m2) 234 !! - evap : Evaporation over the ocean (kg/m2/s)235 233 !! - emp : evaporation minus precipitation (kg/m2/s) 236 234 !! … … 425 423 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pui ! ice surface velocity (i- and i- components [m/s] 426 424 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pvi ! at I-point (B-grid) or U & V-point (C-grid) 427 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb ! ice albedo ( clear sky) (alb_ice_cs)[%]425 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb ! ice albedo (all skies) [%] 428 426 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_taui ! i- & j-components of surface ice stress [N/m2] 429 427 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) … … 445 443 REAL(wp) :: zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb 446 444 REAL(wp) :: zztmp ! temporary variable 447 REAL(wp) :: zcoef_frca ! fractional cloud amount448 445 REAL(wp) :: zwnorm_f, zwndi_f , zwndj_f ! relative wind module and components at F-point 449 446 REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point … … 469 466 zcoef_dqla = -Ls * Cice * 11637800. * (-5897.8) 470 467 zcoef_dqsb = rhoa * cpa * Cice 471 zcoef_frca = 1.0 - 0.3472 468 473 469 !!gm brutal.... … … 587 583 ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 588 584 589 p_fr1(:,:) = ( 0.18 * ( 1.0 - zcoef_frca ) + 0.35 * zcoef_frca)590 p_fr2(:,:) = ( 0.82 * ( 1.0 - zcoef_frca ) + 0.65 * zcoef_frca)585 p_fr1(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 586 p_fr2(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 591 587 592 588 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac ! total precipitation [kg/m2/s] -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90
r4897 r4901 82 82 !! - utau, vtau i- and j-component of the wind stress 83 83 !! - taum wind stress module at T-point 84 !! - wndm 10m wind module at T-point 84 !! - wndm 10m wind module at T-point over free ocean or leads in presence of sea-ice 85 85 !! - qns, qsr non-slor and solar heat flux 86 86 !! - emp evaporation minus precipitation -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r4897 r4901 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 … … 58 50 IMPLICIT NONE 59 51 PRIVATE 60 52 !EM XIOS-OASIS-MCT compliance 53 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 61 54 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90 62 55 PUBLIC sbc_cpl_snd ! routine called by step.F90 … … 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) ) 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 … … 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 ! … … 1296 1270 ENDIF 1297 1271 1298 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 1272 ! ! ========================= ! 1273 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt ! 1274 ! ! ========================= ! 1299 1275 CASE ('coupled') 1300 1276 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN … … 1308 1284 END SELECT 1309 1285 1310 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 1286 ! ! ========================= ! 1287 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt ! 1288 ! ! ========================= ! 1311 1289 CASE ('coupled') 1312 1290 topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) … … 1314 1292 END SELECT 1315 1293 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 ) 1294 ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 ) 1295 ! Used for LIM2 and LIM3 1319 1296 ! 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 1297 ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 1298 fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 1299 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1324 1300 1325 1301 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) … … 1336 1312 !! ** Purpose : provide the ocean-ice informations to the atmosphere 1337 1313 !! 1338 !! ** Method : send to the atmosphere through a call to cpl_ prism_snd1314 !! ** Method : send to the atmosphere through a call to cpl_snd 1339 1315 !! all the needed fields (as defined in sbc_cpl_init) 1340 1316 !!---------------------------------------------------------------------- … … 1355 1331 1356 1332 zfr_l(:,:) = 1.- fr_i(:,:) 1357 1358 1333 ! ! ------------------------- ! 1359 1334 ! ! Surface temperature ! in Kelvin … … 1380 1355 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1381 1356 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 ! 1357 IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1358 IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info ) 1359 IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1360 ENDIF 1387 1361 ! ! ------------------------- ! 1388 1362 ! ! Albedo ! … … 1390 1364 IF( ssnd(jps_albice)%laction ) THEN ! ice 1391 1365 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1392 CALL cpl_ prism_snd( jps_albice, isec, ztmp3, info )1366 CALL cpl_snd( jps_albice, isec, ztmp3, info ) 1393 1367 ENDIF 1394 1368 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean … … 1397 1371 ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 1398 1372 ENDDO 1399 CALL cpl_ prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )1373 CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1400 1374 ENDIF 1401 1375 ! ! ------------------------- ! … … 1409 1383 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1410 1384 END SELECT 1411 CALL cpl_ prism_snd( jps_fice, isec, ztmp3, info )1385 CALL cpl_snd( jps_fice, isec, ztmp3, info ) 1412 1386 ENDIF 1413 1387 … … 1434 1408 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 1435 1409 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 )1410 IF( ssnd(jps_hice)%laction ) CALL cpl_snd( jps_hice, isec, ztmp3, info ) 1411 IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 1438 1412 ENDIF 1439 1413 ! … … 1442 1416 ! ! CO2 flux from PISCES ! 1443 1417 ! ! ------------------------- ! 1444 IF( ssnd(jps_co2)%laction ) CALL cpl_ prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )1418 IF( ssnd(jps_co2)%laction ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 1445 1419 ! 1446 1420 #endif … … 1565 1539 ENDIF 1566 1540 ! 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 grid1541 IF( ssnd(jps_ocx1)%laction ) CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid 1542 IF( ssnd(jps_ocy1)%laction ) CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid 1543 IF( ssnd(jps_ocz1)%laction ) CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid 1570 1544 ! 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 grid1545 IF( ssnd(jps_ivx1)%laction ) CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid 1546 IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid 1547 IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid 1574 1548 ! 1575 1549 ENDIF … … 1582 1556 END SUBROUTINE sbc_cpl_snd 1583 1557 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 1558 !!====================================================================== 1616 1559 END MODULE sbccpl -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r4897 r4901 95 95 END FUNCTION sbc_ice_cice_alloc 96 96 97 SUBROUTINE sbc_ice_cice( kt, nsbc )97 SUBROUTINE sbc_ice_cice( kt, ksbc ) 98 98 !!--------------------------------------------------------------------- 99 99 !! *** ROUTINE sbc_ice_cice *** … … 113 113 !!--------------------------------------------------------------------- 114 114 INTEGER, INTENT(in) :: kt ! ocean time step 115 INTEGER, INTENT(in) :: nsbc ! surface forcing type115 INTEGER, INTENT(in) :: ksbc ! surface forcing type 116 116 !!---------------------------------------------------------------------- 117 117 ! … … 123 123 124 124 ! Make sure any fluxes required for CICE are set 125 IF ( nsbc == 2 )THEN125 IF ( ksbc == jp_flx ) THEN 126 126 CALL cice_sbc_force(kt) 127 ELSE IF ( nsbc == 5) THEN127 ELSE IF ( ksbc == jp_cpl ) THEN 128 128 CALL sbc_cpl_ice_flx( 1.0-fr_i ) 129 129 ENDIF 130 130 131 CALL cice_sbc_in ( kt, nsbc )131 CALL cice_sbc_in ( kt, ksbc ) 132 132 CALL CICE_Run 133 CALL cice_sbc_out ( kt, nsbc )134 135 IF ( nsbc == 5) CALL cice_sbc_hadgam(kt+1)133 CALL cice_sbc_out ( kt, ksbc ) 134 135 IF ( ksbc == jp_cpl ) CALL cice_sbc_hadgam(kt+1) 136 136 137 137 ENDIF ! End sea-ice time step only … … 141 141 END SUBROUTINE sbc_ice_cice 142 142 143 SUBROUTINE cice_sbc_init ( nsbc)143 SUBROUTINE cice_sbc_init (ksbc) 144 144 !!--------------------------------------------------------------------- 145 145 !! *** ROUTINE cice_sbc_init *** 146 146 !! ** Purpose: Initialise ice related fields for NEMO and coupling 147 147 !! 148 INTEGER, INTENT( in ) :: nsbc ! surface forcing type148 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 149 149 REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 150 150 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar … … 165 165 166 166 ! Do some CICE consistency checks 167 IF ( ( nsbc == 2) .OR. (nsbc == 5) ) THEN167 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 168 168 IF ( calc_strair .OR. calc_Tsfc ) THEN 169 169 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) 170 170 ENDIF 171 ELSEIF ( nsbc == 4) THEN171 ELSEIF (ksbc == jp_core) THEN 172 172 IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN 173 173 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' ) … … 190 190 191 191 CALL cice2nemo(aice,fr_i, 'T', 1. ) 192 IF ( ( nsbc == 2).OR.(nsbc == 5) ) THEN192 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 193 193 DO jl=1,ncat 194 194 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 232 232 233 233 234 SUBROUTINE cice_sbc_in (kt, nsbc)234 SUBROUTINE cice_sbc_in (kt, ksbc) 235 235 !!--------------------------------------------------------------------- 236 236 !! *** ROUTINE cice_sbc_in *** … … 238 238 !!--------------------------------------------------------------------- 239 239 INTEGER, INTENT(in ) :: kt ! ocean time step 240 INTEGER, INTENT(in ) :: nsbc ! surface forcing type240 INTEGER, INTENT(in ) :: ksbc ! surface forcing type 241 241 242 242 INTEGER :: ji, jj, jl ! dummy loop indices … … 262 262 ! forced and coupled case 263 263 264 IF ( ( nsbc == 2).OR.(nsbc == 5) ) THEN264 IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 265 265 266 266 ztmpn(:,:,:)=0.0 … … 287 287 288 288 ! Surface downward latent heat flux (CI_5) 289 IF ( nsbc == 2) THEN289 IF (ksbc == jp_flx) THEN 290 290 DO jl=1,ncat 291 291 ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) … … 316 316 ! GBM conductive flux through ice (CI_6) 317 317 ! Convert to GBM 318 IF ( nsbc == 2) THEN318 IF (ksbc == jp_flx) THEN 319 319 ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 320 320 ELSE … … 325 325 ! GBM surface heat flux (CI_7) 326 326 ! Convert to GBM 327 IF ( nsbc == 2) THEN327 IF (ksbc == jp_flx) THEN 328 328 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 329 329 ELSE … … 333 333 ENDDO 334 334 335 ELSE IF ( nsbc == 4) THEN335 ELSE IF (ksbc == jp_core) THEN 336 336 337 337 ! Pass CORE forcing fields to CICE (which will calculate heat fluxes etc itself) … … 458 458 459 459 460 SUBROUTINE cice_sbc_out (kt, nsbc)460 SUBROUTINE cice_sbc_out (kt,ksbc) 461 461 !!--------------------------------------------------------------------- 462 462 !! *** ROUTINE cice_sbc_out *** … … 464 464 !!--------------------------------------------------------------------- 465 465 INTEGER, INTENT( in ) :: kt ! ocean time step 466 INTEGER, INTENT( in ) :: nsbc ! surface forcing type466 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 467 467 468 468 INTEGER :: ji, jj, jl ! dummy loop indices … … 510 510 ! Freshwater fluxes 511 511 512 IF ( nsbc == 2) THEN512 IF (ksbc == jp_flx) THEN 513 513 ! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip) 514 514 ! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below … … 516 516 ! Better to use evap and tprecip? (but for now don't read in evap in this case) 517 517 emp(:,:) = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 518 ELSE IF ( nsbc == 4) THEN518 ELSE IF (ksbc == jp_core) THEN 519 519 emp(:,:) = (1.0-fr_i(:,:))*emp(:,:) 520 ELSE IF ( nsbc ==5) THEN520 ELSE IF (ksbc == jp_cpl) THEN 521 521 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) 522 522 ! This is currently as required with the coupling fields from the UM atmosphere … … 543 543 ! Scale qsr and qns according to ice fraction (bulk formulae only) 544 544 545 IF ( nsbc == 4) THEN545 IF (ksbc == jp_core) THEN 546 546 qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:)) 547 547 qns(:,:)=qns(:,:)*(1.0-fr_i(:,:)) 548 548 ENDIF 549 549 ! Take into account snow melting except for fully coupled when already in qns_tot 550 IF ( nsbc == 5) THEN550 IF (ksbc == jp_cpl) THEN 551 551 qsr(:,:)= qsr_tot(:,:) 552 552 qns(:,:)= qns_tot(:,:) … … 575 575 576 576 CALL cice2nemo(aice,fr_i,'T', 1. ) 577 IF ( ( nsbc == 2).OR.(nsbc == 5) ) THEN577 IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 578 578 DO jl=1,ncat 579 579 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 611 611 612 612 613 #if defined key_oasis3 || defined key_oasis4614 613 SUBROUTINE cice_sbc_hadgam( kt ) 615 614 !!--------------------------------------------------------------------- … … 653 652 END SUBROUTINE cice_sbc_hadgam 654 653 655 #else656 SUBROUTINE cice_sbc_hadgam( kt ) ! Dummy routine657 INTEGER, INTENT( in ) :: kt ! ocean time step658 WRITE(*,*) 'cice_sbc_hadgam: You should not have seen this print! error?'659 END SUBROUTINE cice_sbc_hadgam660 #endif661 654 662 655 SUBROUTINE cice_sbc_final … … 1001 994 CONTAINS 1002 995 1003 SUBROUTINE sbc_ice_cice ( kt, nsbc ) ! Dummy routine996 SUBROUTINE sbc_ice_cice ( kt, ksbc ) ! Dummy routine 1004 997 WRITE(*,*) 'sbc_ice_cice: You should not have seen this print! error?', kt 1005 998 END SUBROUTINE sbc_ice_cice 1006 999 1007 SUBROUTINE cice_sbc_init ( nsbc) ! Dummy routine1000 SUBROUTINE cice_sbc_init (ksbc) ! Dummy routine 1008 1001 WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?' 1009 1002 END SUBROUTINE cice_sbc_init -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
r4897 r4901 16 16 USE eosbn2 ! equation of state 17 17 USE sbc_oce ! surface boundary condition: ocean fields 18 USE sbccpl 18 #if defined key_lim3 19 USE ice , ONLY : a_i 20 #else 21 USE sbc_ice, ONLY : a_i 22 #endif 19 23 USE fldread ! read input field 20 24 USE iom ! I/O manager library … … 101 105 fr_i(:,:) = eos_fzp( sss_m ) * tmask(:,:,1) ! sea surface freezing temperature [Celcius] 102 106 103 !!OM : probleme. a_i pas defini dans les cas lim3 et cice 104 !!gm Not sure at all that a_i should be defined.... ==>>> to be checked 105 #if defined key_coupled && defined key_lim2 106 a_i(:,:,1) = fr_i(:,:) 107 #endif 107 IF( lk_cpl ) a_i(:,:,1) = fr_i(:,:) 108 108 109 109 ! Flux and ice fraction computation -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r4897 r4901 93 93 !! 94 94 INTEGER :: ji, jj ! dummy loop indices 95 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_os ! albedo of the ice under overcast sky 96 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_cs ! albedo of ice under clear sky 97 REAL(wp), DIMENSION(:,:,:), POINTER :: zsist ! surface ice temperature (K) 95 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_os ! ice albedo under overcast sky 96 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_cs ! ice albedo under clear sky 97 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice ! mean ice albedo 98 REAL(wp), DIMENSION(:,:,:), POINTER :: zsist ! ice surface temperature (K) 98 99 !!---------------------------------------------------------------------- 99 100 100 CALL wrk_alloc( jpi,jpj,1, zalb_ ice_os, zalb_ice_cs, zsist )101 CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 101 102 102 103 IF( kt == nit000 ) THEN … … 144 145 zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) ) 145 146 146 ! ... ice albedo (clear sky and overcast sky) 147 ! Ice albedo 148 147 149 CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), & 148 150 reshape( hsnif, (/jpi,jpj,1/) ), & 149 zalb_ice_cs, zalb_ice_os ) 151 zalb_cs, zalb_os ) 152 153 SELECT CASE( ksbc ) 154 CASE( jp_core , jp_cpl ) ! CORE and COUPLED bulk formulations 155 156 ! albedo depends on cloud fraction because of non-linear spectral effects 157 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 158 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 159 ! (zalb_ice) is computed within the bulk routine 160 161 END SELECT 150 162 151 163 ! ... Sea-ice surface boundary conditions output from bulk formulae : … … 163 175 ! 164 176 SELECT CASE( ksbc ) 165 CASE( 3) ! CLIO bulk formulation166 CALL blk_ice_clio( zsist, zalb_ ice_cs, zalb_ice_os,&177 CASE( jp_clio ) ! CLIO bulk formulation 178 CALL blk_ice_clio( zsist, zalb_cs , zalb_os , zalb_ice , & 167 179 & utau_ice , vtau_ice , qns_ice , qsr_ice, & 168 180 & qla_ice , dqns_ice , dqla_ice , & … … 170 182 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 171 183 172 CASE( 4) ! CORE bulk formulation173 CALL blk_ice_core( zsist, u_ice , v_ice , zalb_ice _cs, &184 CASE( jp_core ) ! CORE bulk formulation 185 CALL blk_ice_core( zsist, u_ice , v_ice , zalb_ice , & 174 186 & utau_ice , vtau_ice , qns_ice , qsr_ice, & 175 187 & qla_ice , dqns_ice , dqla_ice , & 176 188 & tprecip , sprecip , & 177 189 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 178 IF( ltrcdm2dc_ice ) CALL blk_ice_meanqsr( zalb_ice _cs, qsr_ice_mean, jpl )179 180 CASE( 5 )! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)190 IF( ltrcdm2dc_ice ) CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl ) 191 192 CASE( jp_cpl ) ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 181 193 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 182 194 END SELECT … … 206 218 IF( ln_limdmp ) CALL lim_dmp_2 ( kt ) ! Ice damping 207 219 END IF 208 #if defined key_coupled209 220 ! ! Ice surface fluxes in coupled mode 210 IF( ksbc == 5) THEN221 IF( ksbc == jp_cpl ) THEN 211 222 a_i(:,:,1)=fr_i 212 223 CALL sbc_cpl_ice_flx( frld, & 213 224 ! optional arguments, used only in 'mixed oce-ice' case 214 & palbi = zalb_ice _cs, psst = sst_m, pist = zsist )225 & palbi = zalb_ice, psst = sst_m, pist = zsist ) 215 226 sprecip(:,:) = - emp_ice(:,:) ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 216 227 ENDIF 217 #endif218 228 CALL lim_thd_2 ( kt ) ! Ice thermodynamics 219 229 CALL lim_sbc_flx_2 ( kt ) ! update surface ocean mass, heat & salt fluxes … … 245 255 IF( ln_limdyn ) CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 246 256 ! 247 CALL wrk_dealloc( jpi,jpj,1, zalb_ ice_os, zalb_ice_cs, zsist )257 CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 248 258 ! 249 259 END SUBROUTINE sbc_ice_lim_2 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r4897 r4901 37 37 USE sbcice_cice ! surface boundary condition: CICE sea-ice model 38 38 USE sbccpl ! surface boundary condition: coupled florulation 39 USE cpl_oasis3, ONLY:lk_cpl ! are we in coupled mode?40 39 USE sbcssr ! surface boundary condition: sea surface restoring 41 40 USE sbcrnf ! surface boundary condition: runoffs … … 82 81 INTEGER :: icpt ! local integer 83 82 !! 84 NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx, ln_blk_clio, ln_blk_core, ln_cpl,&83 NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx, ln_blk_clio, ln_blk_core, & 85 84 & ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc , ln_rnf, & 86 & ln_ssr , nn_fwb , ln_cdgw , ln_wave , ln_sdw, nn_lsm, cn_iceflx85 & ln_ssr , nn_fwb , ln_cdgw , ln_wave , ln_sdw, nn_lsm, nn_limflx 87 86 INTEGER :: ios 88 87 !!---------------------------------------------------------------------- … … 123 122 WRITE(numout,*) ' CORE bulk formulation ln_blk_core = ', ln_blk_core 124 123 WRITE(numout,*) ' MFS bulk formulation ln_blk_mfs = ', ln_blk_mfs 125 WRITE(numout,*) ' coupled formulation (T if key_ sbc_cpl) ln_cpl = ', ln_cpl126 WRITE(numout,*) ' Flux handling over ice categories cn_iceflx = ', TRIM (cn_iceflx)124 WRITE(numout,*) ' coupled formulation (T if key_oasis3) lk_cpl = ', lk_cpl 125 WRITE(numout,*) ' Multicategory heat flux formulation (LIM3) nn_limflx = ', nn_limflx 127 126 WRITE(numout,*) ' Misc. options of sbc : ' 128 127 WRITE(numout,*) ' Patm gradient added in ocean & ice Eqs. ln_apr_dyn = ', ln_apr_dyn … … 137 136 ENDIF 138 137 139 ! Flux handling over ice categories 140 #if defined key_coupled 141 SELECT CASE ( TRIM (cn_iceflx)) 142 CASE ('ave') 143 ln_iceflx_ave = .TRUE. 144 ln_iceflx_linear = .FALSE. 145 CASE ('linear') 146 ln_iceflx_ave = .FALSE. 147 ln_iceflx_linear = .TRUE. 148 CASE default 149 ln_iceflx_ave = .FALSE. 150 ln_iceflx_linear = .FALSE. 138 ! LIM3 Multi-category heat flux formulation 139 SELECT CASE ( nn_limflx) 140 CASE ( -1 ) 141 IF(lwp) WRITE(numout,*) ' Use of per-category fluxes (nn_limflx = -1) ' 142 CASE ( 0 ) 143 IF(lwp) WRITE(numout,*) ' Average per-category fluxes (nn_limflx = 0) ' 144 CASE ( 1 ) 145 IF(lwp) WRITE(numout,*) ' Average then redistribute per-category fluxes (nn_limflx = 1) ' 146 CASE ( 2 ) 147 IF(lwp) WRITE(numout,*) ' Redistribute a single flux over categories (nn_limflx = 2) ' 151 148 END SELECT 152 IF(lwp) WRITE(numout,*) ' Fluxes averaged over all ice categories ln_iceflx_ave = ', ln_iceflx_ave153 IF(lwp) WRITE(numout,*) ' Fluxes distributed linearly over ice categories ln_iceflx_linear = ', ln_iceflx_linear154 #endif155 149 ! 156 150 #if defined key_top && ! defined key_offline … … 206 200 IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 ) & 207 201 & CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 1 or 2' ) 208 #if defined key_coupled 209 IF( ln_iceflx_ave .AND. ln_iceflx_linear ) & 210 & CALL ctl_stop( ' ln_iceflx_ave and ln_iceflx_linear options are not compatible' ) 211 IF( ( nn_ice ==3 .AND. lk_cpl) .AND. .NOT. ( ln_iceflx_ave .OR. ln_iceflx_linear ) ) & 212 & CALL ctl_stop( ' With lim3 coupled, either ln_iceflx_ave or ln_iceflx_linear must be set to .TRUE.' ) 213 #endif 202 IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) ) & 203 & WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3' 204 IF( ( nn_ice == 3 ) .AND. ( lk_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) ) & 205 & CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 206 IF( ( nn_ice == 3 ) .AND. ( .NOT. lk_cpl ) .AND. ( nn_limflx == 2 ) ) & 207 & CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' ) 208 214 209 IF( ln_dm2dc ) nday_qsr = -1 ! initialisation flag 215 210 … … 236 231 ! ! Choice of the Surface Boudary Condition (set nsbc) 237 232 icpt = 0 238 IF( ln_ana ) THEN ; nsbc = 1; icpt = icpt + 1 ; ENDIF ! analytical formulation239 IF( ln_flx ) THEN ; nsbc = 2; icpt = icpt + 1 ; ENDIF ! flux formulation240 IF( ln_blk_clio ) THEN ; nsbc = 3; icpt = icpt + 1 ; ENDIF ! CLIO bulk formulation241 IF( ln_blk_core ) THEN ; nsbc = 4; icpt = icpt + 1 ; ENDIF ! CORE bulk formulation242 IF( ln_blk_mfs ) THEN ; nsbc = 6; icpt = icpt + 1 ; ENDIF ! MFS bulk formulation243 IF( l n_cpl ) THEN ; nsbc = 5; icpt = icpt + 1 ; ENDIF ! Coupled formulation244 IF( cp_cfg == 'gyre') THEN ; nsbc = 0; ENDIF ! GYRE analytical formulation245 IF( lk_esopa ) nsbc = -1! esopa test, ALL formulations233 IF( ln_ana ) THEN ; nsbc = jp_ana ; icpt = icpt + 1 ; ENDIF ! analytical formulation 234 IF( ln_flx ) THEN ; nsbc = jp_flx ; icpt = icpt + 1 ; ENDIF ! flux formulation 235 IF( ln_blk_clio ) THEN ; nsbc = jp_clio ; icpt = icpt + 1 ; ENDIF ! CLIO bulk formulation 236 IF( ln_blk_core ) THEN ; nsbc = jp_core ; icpt = icpt + 1 ; ENDIF ! CORE bulk formulation 237 IF( ln_blk_mfs ) THEN ; nsbc = jp_mfs ; icpt = icpt + 1 ; ENDIF ! MFS bulk formulation 238 IF( lk_cpl ) THEN ; nsbc = jp_cpl ; icpt = icpt + 1 ; ENDIF ! Coupled formulation 239 IF( cp_cfg == 'gyre') THEN ; nsbc = jp_gyre ; ENDIF ! GYRE analytical formulation 240 IF( lk_esopa ) nsbc = jp_esopa ! esopa test, ALL formulations 246 241 ! 247 242 IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN … … 254 249 IF(lwp) THEN 255 250 WRITE(numout,*) 256 IF( nsbc == -1 ) WRITE(numout,*) ' ESOPA test All surface boundary conditions' 257 IF( nsbc == 0 ) WRITE(numout,*) ' GYRE analytical formulation' 258 IF( nsbc == 1 ) WRITE(numout,*) ' analytical formulation' 259 IF( nsbc == 2 ) WRITE(numout,*) ' flux formulation' 260 IF( nsbc == 3 ) WRITE(numout,*) ' CLIO bulk formulation' 261 IF( nsbc == 4 ) WRITE(numout,*) ' CORE bulk formulation' 262 IF( nsbc == 5 ) WRITE(numout,*) ' coupled formulation' 263 IF( nsbc == 6 ) WRITE(numout,*) ' MFS Bulk formulation' 264 ENDIF 265 ! 266 CALL sbc_ssm_init ! Sea-surface mean fields initialisation 267 ! 268 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialisation 269 ! 270 IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialisation 271 ! 251 IF( nsbc == jp_esopa ) WRITE(numout,*) ' ESOPA test All surface boundary conditions' 252 IF( nsbc == jp_gyre ) WRITE(numout,*) ' GYRE analytical formulation' 253 IF( nsbc == jp_ana ) WRITE(numout,*) ' analytical formulation' 254 IF( nsbc == jp_flx ) WRITE(numout,*) ' flux formulation' 255 IF( nsbc == jp_clio ) WRITE(numout,*) ' CLIO bulk formulation' 256 IF( nsbc == jp_core ) WRITE(numout,*) ' CORE bulk formulation' 257 IF( nsbc == jp_cpl ) WRITE(numout,*) ' coupled formulation' 258 IF( nsbc == jp_mfs ) WRITE(numout,*) ' MFS Bulk formulation' 259 ENDIF 260 ! 261 CALL sbc_ssm_init ! Sea-surface mean fields initialisation 262 ! 263 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialisation 264 ! 265 IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialisation 266 ! 267 IF( nsbc == jp_cpl ) CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before first time step 268 272 269 END SUBROUTINE sbc_init 273 270 … … 320 317 SELECT CASE( nsbc ) ! Compute ocean surface boundary condition 321 318 ! ! (i.e. utau,vtau, qns, qsr, emp, sfx) 322 CASE( 0) ; CALL sbc_gyre ( kt ) ! analytical formulation : GYRE configuration323 CASE( 1) ; CALL sbc_ana ( kt ) ! analytical formulation : uniform sbc324 CASE( 2) ; CALL sbc_flx ( kt ) ! flux formulation325 CASE( 3) ; CALL sbc_blk_clio( kt ) ! bulk formulation : CLIO for the ocean326 CASE( 4) ; CALL sbc_blk_core( kt ) ! bulk formulation : CORE for the ocean327 CASE( 5) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! coupled formulation328 CASE( 6) ; CALL sbc_blk_mfs ( kt ) ! bulk formulation : MFS for the ocean329 CASE( -1)330 CALL sbc_ana ( kt ) ! ESOPA, test ALL the formulations331 CALL sbc_gyre ( kt ) !332 CALL sbc_flx ( kt ) !333 CALL sbc_blk_clio( kt ) !334 CALL sbc_blk_core( kt ) !335 CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) !319 CASE( jp_gyre ) ; CALL sbc_gyre ( kt ) ! analytical formulation : GYRE configuration 320 CASE( jp_ana ) ; CALL sbc_ana ( kt ) ! analytical formulation : uniform sbc 321 CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation 322 CASE( jp_clio ) ; CALL sbc_blk_clio( kt ) ! bulk formulation : CLIO for the ocean 323 CASE( jp_core ) ; CALL sbc_blk_core( kt ) ! bulk formulation : CORE for the ocean 324 CASE( jp_cpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! coupled formulation 325 CASE( jp_mfs ) ; CALL sbc_blk_mfs ( kt ) ! bulk formulation : MFS for the ocean 326 CASE( jp_esopa ) 327 CALL sbc_ana ( kt ) ! ESOPA, test ALL the formulations 328 CALL sbc_gyre ( kt ) ! 329 CALL sbc_flx ( kt ) ! 330 CALL sbc_blk_clio( kt ) ! 331 CALL sbc_blk_core( kt ) ! 332 CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! 336 333 END SELECT 337 334 … … 342 339 CASE( 2 ) ; CALL sbc_ice_lim_2( kt, nsbc ) ! LIM-2 ice model 343 340 CASE( 3 ) ; CALL sbc_ice_lim ( kt, nsbc ) ! LIM-3 ice model 344 !is it useful?345 341 CASE( 4 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model 346 342 END SELECT … … 414 410 CALL iom_put( "qsr" , qsr ) ! solar heat flux 415 411 IF( nn_ice > 0 ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction 412 CALL iom_put( "taum" , taum ) ! wind stress module 413 CALL iom_put( "wspd" , wndm ) ! wind speed module over free ocean or leads in presence of sea-ice 416 414 ENDIF 417 415 ! 418 416 CALL iom_put( "utau", utau ) ! i-wind stress (stress can be updated at 419 417 CALL iom_put( "vtau", vtau ) ! j-wind stress each time step in sea-ice) 420 CALL iom_put( "taum", taum ) ! wind stress module421 CALL iom_put( "wspd", wndm ) ! wind speed module422 418 ! 423 419 IF(ln_ctl) THEN ! print mean trends (used for debugging) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r4897 r4901 10 10 !! - ! 2005-11 (G. Madec) zco, zps, sco coordinate 11 11 !! 3.2 ! 2009-04 (G. Madec & NEMO team) 12 !! 3.6! 2012-05 (C. Rousset) store attenuation coef for use in ice model12 !! 4.0 ! 2012-05 (C. Rousset) store attenuation coef for use in ice model 13 13 !!---------------------------------------------------------------------- 14 14 … … 17 17 !! tra_qsr_init : solar radiation penetration initialization 18 18 !!---------------------------------------------------------------------- 19 USE oce ! ocean dynamics and active tracers 20 USE dom_oce ! ocean space and time domain 21 USE sbc_oce ! surface boundary condition: ocean 22 USE trc_oce ! share SMS/Ocean variables 23 USE trd_oce ! trends: ocean variables 24 USE trdtra ! trends manager: tracers 25 USE phycst ! physical constants 26 USE sbc_ice, ONLY : lk_lim3 27 ! 28 USE in_out_manager ! I/O manager 29 USE prtctl ! Print control 30 USE iom ! I/O manager 31 USE fldread ! read input fields 32 USE lib_mpp ! MPP library 19 USE oce ! ocean dynamics and active tracers 20 USE dom_oce ! ocean space and time domain 21 USE sbc_oce ! surface boundary condition: ocean 22 USE trc_oce ! share SMS/Ocean variables 23 USE trdmod_oce ! ocean variables trends 24 USE trdtra ! ocean active tracers trends 25 USE in_out_manager ! I/O manager 26 USE phycst ! physical constants 27 USE prtctl ! Print control 28 USE iom ! I/O manager 29 USE fldread ! read input fields 30 USE restart ! ocean restart 31 USE lib_mpp ! MPP library 33 32 USE wrk_nemo ! Memory Allocation 34 33 USE timing ! Timing 34 USE sbc_ice, ONLY : lk_lim3 35 35 36 36 IMPLICIT NONE … … 51 51 REAL(wp), PUBLIC :: rn_si1 !: deepest depth of extinction (water type I) (2 bands) 52 52 53 INTEGER , PUBLIC :: nksr !: levels below which the light cannot penetrate ( depth larger than 391 m) 54 55 REAL(wp) :: xsi0r, xsi1r ! inverse of rn_si0 and rn_si1, resp. 56 REAL(wp), DIMENSION(3,61) :: rkrgb ! tabulated attenuation coefficients for RGB absorption 53 ! Module variables 54 REAL(wp) :: xsi0r !: inverse of rn_si0 55 REAL(wp) :: xsi1r !: inverse of rn_si1 57 56 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_chl ! structure of input Chl (file informations, fields read) 57 INTEGER, PUBLIC :: nksr ! levels below which the light cannot penetrate ( depth larger than 391 m) 58 REAL(wp), DIMENSION(3,61) :: rkrgb !: tabulated attenuation coefficients for RGB absorption 58 59 59 60 !! * Substitutions … … 89 90 !! 90 91 !! ** Action : - update ta with the penetrative solar radiation trend 91 !! - s end the trend to trdtra (l_trdtra=T)92 !! - save the trend in ttrd ('key_trdtra') 92 93 !! 93 94 !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp. 94 95 !! Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516. 95 96 !!---------------------------------------------------------------------- 97 ! 96 98 INTEGER, INTENT(in) :: kt ! ocean time-step 97 99 ! … … 118 120 ENDIF 119 121 120 IF( l_trdtra ) THEN ! Save t emperaturetrends122 IF( l_trdtra ) THEN ! Save ta and sa trends 121 123 CALL wrk_alloc( jpi, jpj, jpk, ztrdt ) 122 124 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) … … 143 145 ! Compute now qsr tracer content field 144 146 ! ************************************ 147 145 148 ! ! ============================================== ! 146 149 IF( lk_qsr_bio .AND. ln_qsr_bio ) THEN ! bio-model fluxes : all vertical coordinates ! … … 164 167 DO ji = 1, jpi 165 168 IF ( qsr(ji,jj) /= 0._wp ) THEN 166 oatte(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) ) 167 iatte(ji,jj) = oatte(ji,jj) 169 fraqsr_1lev(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) ) 168 170 ENDIF 169 171 END DO … … 180 182 IF( nn_chldta == 1 .OR. lk_vvl ) THEN !* Variable Chlorophyll or ocean volume 181 183 ! 182 IF( nn_chldta == 1 ) THEN ! -Variable Chlorophyll184 IF( nn_chldta == 1 ) THEN !* Variable Chlorophyll 183 185 ! 184 186 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step … … 196 198 END DO 197 199 END DO 198 ELSE !-Variable ocean volume but constant chrlorophyll199 zchl = 0.05 200 ELSE ! Variable ocean volume but constant chrlorophyll 201 zchl = 0.05 ! constant chlorophyll 200 202 irgb = NINT( 41 + 20.*LOG10( zchl ) + 1.e-15 ) 201 zekb(:,:) = rkrgb(1,irgb) 203 zekb(:,:) = rkrgb(1,irgb) ! Separation in R-G-B depending of the chlorophyll 202 204 zekg(:,:) = rkrgb(2,irgb) 203 205 zekr(:,:) = rkrgb(3,irgb) 204 206 ENDIF 205 207 ! 206 zcoef = ( 1. - rn_abs ) / 3.e0 !-equi-partition in R-G-B207 ze0(:,:,1) = rn_abs * qsr(:,:)208 ze1(:,:,1) = 209 ze2(:,:,1) = 210 ze3(:,:,1) = 211 zea(:,:,1) = 208 zcoef = ( 1. - rn_abs ) / 3.e0 ! equi-partition in R-G-B 209 ze0(:,:,1) = rn_abs * qsr(:,:) 210 ze1(:,:,1) = zcoef * qsr(:,:) 211 ze2(:,:,1) = zcoef * qsr(:,:) 212 ze3(:,:,1) = zcoef * qsr(:,:) 213 zea(:,:,1) = qsr(:,:) 212 214 ! 213 215 DO jk = 2, nksr+1 … … 236 238 zzc2 = zcoef * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) ) 237 239 zzc3 = zcoef * EXP( - fse3t(ji,jj,1) * zekr(ji,jj) ) 238 oatte(ji,jj) = 1.0 - ( zzc0 + zzc1 + zzc2 + zzc3 ) * tmask(ji,jj,2) 239 iatte(ji,jj) = 1.0 - ( zzc0 + zzc1 + zcoef + zcoef ) * tmask(ji,jj,2) 240 fraqsr_1lev(ji,jj) = 1.0 - ( zzc0 + zzc1 + zzc2 + zzc3 ) * tmask(ji,jj,2) 240 241 END DO 241 242 END DO … … 254 255 ! clem: store attenuation coefficient of the first ocean level 255 256 IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 256 257 !!gm BUG ?????? ? ? ? 258 oatte(:,:) = etot3(:,:,1) / r1_rau0_rcp 259 iatte(:,:) = oatte(:,:) 257 fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 260 258 ENDIF 261 259 ENDIF … … 284 282 zc0 = zz0 * EXP( -fsdepw(ji,jj,1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,1)*xsi1r ) 285 283 zc1 = zz0 * EXP( -fsdepw(ji,jj,2)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,2)*xsi1r ) 286 oatte(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp 287 iatte(ji,jj) = oatte(ji,jj) 284 fraqsr_1lev(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp 288 285 END DO 289 286 END DO … … 299 296 ! clem: store attenuation coefficient of the first ocean level 300 297 IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 301 oatte(:,:) = etot3(:,:,1) / r1_rau0_rcp 302 iatte(:,:) = oatte(:,:) 298 fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 303 299 ENDIF 304 300 ! … … 331 327 IF( l_trdtra ) THEN ! qsr tracers trends saved for diagnostics 332 328 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 333 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ qsr, ztrdt )329 CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_qsr, ztrdt ) 334 330 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt ) 335 331 ENDIF … … 362 358 !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp. 363 359 !!---------------------------------------------------------------------- 360 ! 364 361 INTEGER :: ji, jj, jk ! dummy loop indices 365 362 INTEGER :: irgb, ierror, ioptio, nqsr ! local integer … … 380 377 IF( nn_timing == 1 ) CALL timing_start('tra_qsr_init') 381 378 ! 382 ! clem init for oatte and iatte379 ! Default value for fraqsr_1lev 383 380 IF( .NOT. ln_rstart ) THEN 384 oatte(:,:) = 1._wp 385 iatte(:,:) = 1._wp 381 fraqsr_1lev(:,:) = 1._wp 386 382 ENDIF 387 383 ! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r4897 r4901 732 732 ! 733 733 ! !* Check of some namelist values 734 IF( nn_mxl < 0 .OR. nn_mxl > 3 ) CALL ctl_stop( 'bad flag: nn_mxl is 0, 1 or 2 ' ) 735 IF( nn_pdl < 0 .OR. nn_pdl > 1 ) CALL ctl_stop( 'bad flag: nn_pdl is 0 or 1 ' ) 736 IF( nn_htau < 0 .OR. nn_htau > 1 ) CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' ) 737 #if ! key_coupled 738 IF( nn_etau == 3 ) CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' ) 739 #endif 734 IF( nn_mxl < 0 .OR. nn_mxl > 3 ) CALL ctl_stop( 'bad flag: nn_mxl is 0, 1 or 2 ' ) 735 IF( nn_pdl < 0 .OR. nn_pdl > 1 ) CALL ctl_stop( 'bad flag: nn_pdl is 0 or 1 ' ) 736 IF( nn_htau < 0 .OR. nn_htau > 1 ) CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' ) 737 IF( nn_etau == 3 .AND. .NOT. lk_cpl ) CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' ) 740 738 741 739 IF( ln_mxl0 ) THEN -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r4900 r4901 42 42 !!---------------------------------------------------------------------- 43 43 USE step_oce ! module used in the ocean time stepping module 44 USE sbc_oce ! surface boundary condition: ocean45 44 USE cla ! cross land advection (tra_cla routine) 46 45 USE domcfg ! domain configuration (dom_cfg routine) … … 69 68 USE icbini ! handle bergs, initialisation 70 69 USE icbstp ! handle bergs, calving, themodynamics and transport 71 #if defined key_oasis372 70 USE cpl_oasis3 ! OASIS3 coupling 73 #elif defined key_oasis474 USE cpl_oasis4 ! OASIS4 coupling (not working)75 #endif76 71 USE c1d ! 1D configuration 77 72 USE step_c1d ! Time stepping loop for the 1D configuration … … 197 192 ! 198 193 CALL nemo_closefile 194 ! 199 195 #if defined key_iomput 200 196 CALL xios_finalize ! end mpp communications with xios 201 # if defined key_oasis3 || defined key_oasis4 202 CALL cpl_prism_finalize ! end coupling and mpp communications with OASIS 203 # endif 197 IF( lk_cpl ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 204 198 #else 205 # if defined key_oasis3 || defined key_oasis4 206 CALL cpl_prism_finalize! end coupling and mpp communications with OASIS207 # else 208 IF( lk_mpp ) CALL mppstop! end mpp communications209 # endif 199 IF( lk_cpl ) THEN 200 CALL cpl_finalize ! end coupling and mpp communications with OASIS 201 ELSE 202 IF( lk_mpp ) CALL mppstop ! end mpp communications 203 ENDIF 210 204 #endif 211 205 ! … … 277 271 #if defined key_iomput 278 272 IF( Agrif_Root() ) THEN 279 # if defined key_oasis3 || defined key_oasis4 280 CALL cpl_prism_init( ilocal_comm )! nemo local communicator given by oasis281 CALL xios_initialize( "oceanx",local_comm=ilocal_comm )282 # else 283 CALL xios_initialize( "nemo",return_comm=ilocal_comm )284 # endif 273 IF( lk_cpl ) THEN 274 CALL cpl_init( ilocal_comm ) ! nemo local communicator given by oasis 275 CALL xios_initialize( "oceanx",local_comm=ilocal_comm ) ! send nemo communicator to xios 276 ELSE 277 CALL xios_initialize( "nemo",return_comm=ilocal_comm ) ! nemo local communicator given by xios 278 ENDIF 285 279 ENDIF 286 280 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 287 281 #else 288 # if defined key_oasis3 || defined key_oasis4 289 IF( Agrif_Root() ) THEN290 CALL cpl_prism_init( ilocal_comm )! nemo local communicator given by oasis291 ENDIF292 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt)293 # else 294 ilocal_comm = 0295 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )! Nodes selection (control print return in cltxt)296 # endif 282 IF( lk_cpl ) THEN 283 IF( Agrif_Root() ) THEN 284 CALL cpl_init( ilocal_comm ) ! nemo local communicator given by oasis 285 ENDIF 286 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 287 ELSE 288 ilocal_comm = 0 289 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt) 290 ENDIF 297 291 #endif 298 292 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/oce.F90
r4896 r4901 56 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_fmass !: time evolution of mass of snow+ice [Kg/m2/s] 57 57 58 !! arrays related to penetration of solar fluxes to calculate the heat budget for sea ice59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: oatte, iatte !: attenuation coef of the input solar flux [unitless]58 !! Energy budget of the leads (open water embedded in sea ice) 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fraqsr_1lev !: fraction of solar net radiation absorbed in the first ocean level [-] 60 60 61 61 !!---------------------------------------------------------------------- … … 94 94 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(3) ) 95 95 ! 96 ALLOCATE( iatte(jpi,jpj) , oatte(jpi,jpj) , STAT=ierr(4) )96 ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(4) ) 97 97 ! 98 98 oce_alloc = MAXVAL( ierr ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/step.F90
r4897 r4901 207 207 IF( lk_floats ) CALL flo_stp( kstp ) ! drifting Floats 208 208 IF( lk_diahth ) CALL dia_hth( kstp ) ! Thermocline depth (20 degres isotherm depth) 209 IF( lk_diafwb )CALL dia_fwb( kstp ) ! Fresh water budget diagnostics209 IF( .NOT. lk_cpl ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics 210 210 IF( ln_diaptr ) CALL dia_ptr( kstp ) ! Poleward TRansports diagnostics 211 211 IF( lk_diadct ) CALL dia_dct( kstp ) ! Transports -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r4896 r4901 25 25 USE sbcrnf ! surface boundary condition: runoff variables 26 26 USE sbccpl ! surface boundary condition: coupled formulation (call send at end of step) 27 USE cpl_oasis3, ONLY : lk_cpl27 USE sbc_oce ! surface boundary condition: ocean 28 28 USE sbctide ! Tide initialisation 29 29 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
r4897 r4901 166 166 !! note that we need sbc_ssm called first in sbc 167 167 ! 168 IF( ln_cpl ) THEN169 IF( lwp ) WRITE(numout,*) 'Coupled mode not sensible with StandAlone Surface scheme'170 ln_cpl = .FALSE.171 ENDIF172 168 IF( ln_apr_dyn ) THEN 173 169 IF( lwp ) WRITE(numout,*) 'No atmospheric gradient needed with StandAlone Surface scheme' -
branches/2014/dev_CNRS_2014/NEMOGCM/TOOLS/COMPILE/bld.cfg
r3695 r4901 51 51 bld::excl_dep inc::mpe_logf.h 52 52 bld::excl_dep use::mpi 53 bld::excl_dep use::mod_prism_proto 54 bld::excl_dep use::mod_prism_def_partition_proto 55 bld::excl_dep use::mod_prism_get_comm 56 bld::excl_dep use::mod_prism_get_proto 57 bld::excl_dep use::mod_prism_put_proto 58 bld::excl_dep use::mod_comprism_proto 53 bld::excl_dep use::mod_oasis 59 54 bld::excl_dep use::mkl_dfti 60 55 # Don't generate interface files -
branches/2014/dev_CNRS_2014/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg
r3850 r4901 46 46 bld::excl_dep inc::mpe_logf.h 47 47 bld::excl_dep use::mpi 48 bld::excl_dep use::mod_prism_proto 49 bld::excl_dep use::mod_prism_def_partition_proto 50 bld::excl_dep use::mod_prism_get_comm 51 bld::excl_dep use::mod_prism_get_proto 52 bld::excl_dep use::mod_prism_put_proto 53 bld::excl_dep use::mod_comprism_proto 48 bld::excl_dep use::mod_oasis 54 49 bld::excl_dep use::mkl_dfti 55 50 bld::excl_dep use::nc4interface -
branches/2014/dev_CNRS_2014/NEMOGCM/TOOLS/COMPILE/bldxag.cfg
r3695 r4901 47 47 bld::excl_dep inc::mpe_logf.h 48 48 bld::excl_dep use::mpi 49 bld::excl_dep use::mod_prism_proto 50 bld::excl_dep use::mod_prism_def_partition_proto 51 bld::excl_dep use::mod_prism_get_comm 52 bld::excl_dep use::mod_prism_get_proto 53 bld::excl_dep use::mod_prism_put_proto 54 bld::excl_dep use::mod_comprism_proto 49 bld::excl_dep use::mod_oasis 55 50 bld::excl_dep use::mkl_dfti 56 51 # Don't generate interface files
Note: See TracChangeset
for help on using the changeset viewer.