Changeset 5220 for branches/2015/dev_r5218_CNRS17_coupling
- Timestamp:
- 2015-04-17T11:50:03+02:00 (9 years ago)
- Location:
- branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM
- Files:
-
- 44 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm
r5118 r5220 36 36 %NCDF_HOME /home/acc/shared 37 37 %HDF5_HOME /home/acc/shared 38 %XIOS_HOME /home/acc/XIOS _1.038 %XIOS_HOME /home/acc/XIOS 39 39 %OASIS_HOME 40 40 -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/ARCH/arch-macport_osx.fcm
r4865 r5220 40 40 %NCDF_HOME /opt/local 41 41 %HDF5_HOME /opt/local 42 %XIOS_HOME /Users/$( whoami )/ XIOS42 %XIOS_HOME /Users/$( whoami )/xios-1.0 43 43 %OASIS_HOME /not/defined 44 44 -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg
r5147 r5220 129 129 / 130 130 !----------------------------------------------------------------------- 131 &namsbc_cpl ! coupled ocean/atmosphere model ("key_ coupled")131 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 132 132 !----------------------------------------------------------------------- 133 133 / -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg
r5108 r5220 131 131 / 132 132 !----------------------------------------------------------------------- 133 &namsbc_cpl ! coupled ocean/atmosphere model ("key_ coupled")133 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 134 134 !----------------------------------------------------------------------- 135 135 / -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg
r5102 r5220 116 116 / 117 117 !----------------------------------------------------------------------- 118 &namsbc_cpl ! coupled ocean/atmosphere model ("key_ coupled")118 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 119 119 !----------------------------------------------------------------------- 120 120 / -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg
r5102 r5220 121 121 / 122 122 !----------------------------------------------------------------------- 123 &namsbc_cpl ! coupled ocean/atmosphere model ("key_ coupled")123 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 124 124 !----------------------------------------------------------------------- 125 125 / -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg
r5102 r5220 110 110 / 111 111 !----------------------------------------------------------------------- 112 &namsbc_cpl ! coupled ocean/atmosphere model ("key_ coupled")112 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 113 113 !----------------------------------------------------------------------- 114 114 / -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/CONFIG/ISOMIP/EXP00/namelist_cfg
r5198 r5220 162 162 !! namsbc_core CORE bulk formulae formulation 163 163 !! namsbc_mfs MFS bulk formulae formulation 164 !! namsbc_cpl CouPLed formulation ("key_ coupled")164 !! namsbc_cpl CouPLed formulation ("key_oasis3") 165 165 !! namsbc_sas StAndalone Surface module 166 166 !! namtra_qsr penetrative solar radiation … … 223 223 / 224 224 !----------------------------------------------------------------------- 225 &namsbc_cpl ! coupled ocean/atmosphere model ("key_ coupled")225 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 226 226 !----------------------------------------------------------------------- 227 227 / -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg
r4147 r5220 110 110 !! namsbc_clio CLIO bulk formulea formulation 111 111 !! namsbc_core CORE bulk formulea formulation 112 !! namsbc_cpl CouPLed formulation ("key_ coupled")112 !! namsbc_cpl CouPLed formulation ("key_oasis3") 113 113 !! namtra_qsr penetrative solar radiation 114 114 !! namsbc_rnf river runoffs … … 199 199 / 200 200 !----------------------------------------------------------------------- 201 &namsbc_cpl ! coupled ocean/atmosphere model ("key_ coupled")201 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 202 202 !----------------------------------------------------------------------- 203 203 ! ! description ! multiple ! vector ! vector ! vector ! … … 640 640 ! = 1 add a tke source below the ML 641 641 ! = 2 add a tke source just at the base of the ML 642 ! = 3 as = 1 applied on HF part of the stress ("key_ coupled")642 ! = 3 as = 1 applied on HF part of the stress ("key_oasis3") 643 643 rn_efr = 0.05 ! fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2) 644 644 nn_htau = 1 ! type of exponential decrease of tke penetration below the ML -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg
r4370 r5220 104 104 / 105 105 !----------------------------------------------------------------------- 106 &namsbc_cpl ! coupled ocean/atmosphere model ("key_ coupled")106 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 107 107 !----------------------------------------------------------------------- 108 108 / -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/CONFIG/SHARED/field_def.xml
r5147 r5220 195 195 <field id="taum_oce" long_name="wind stress module over open ocean" unit="N/m2" /> 196 196 197 <!-- available key_ coupled-->197 <!-- available key_oasis3 --> 198 198 <field id="snow_ao_cea" long_name="Snow over ice-free ocean (cell average)" unit="kg/m2/s" /> 199 199 <field id="snow_ai_cea" long_name="Snow over sea-ice (cell average)" unit="kg/m2/s" /> … … 201 201 <field id="icealb_cea" long_name="Ice albedo (cell average)" unit="1" /> 202 202 <field id="calving" long_name="Calving" unit="kg/m2/s" /> 203 <!-- available if key_ coupled+ conservative method -->203 <!-- available if key_oasis3 + conservative method --> 204 204 <field id="rain" long_name="Liquid precipitation" unit="Kg/m2/s" /> 205 205 <field id="evap_ao_cea" long_name="Evaporation over ice-free ocean (cell average)" unit="kg/m2/s" /> -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/CONFIG/SHARED/namelist_ref
r5190 r5220 215 215 !! namsbc_core CORE bulk formulae formulation 216 216 !! namsbc_mfs MFS bulk formulae formulation 217 !! namsbc_cpl CouPLed formulation ("key_ coupled")217 !! namsbc_cpl CouPLed formulation ("key_oasis3") 218 218 !! namsbc_sas StAndalone Surface module 219 219 !! namtra_qsr penetrative solar radiation … … 235 235 ln_blk_core = .true. ! CORE bulk formulation (T => fill namsbc_core) 236 236 ln_blk_mfs = .false. ! MFS bulk formulation (T => fill namsbc_mfs ) 237 ln_cpl = .false. ! atmosphere coupled formulation ( requires key_oasis3 ) 238 ln_mixcpl = .false. ! forced-coupled mixed formulation ( requires key_oasis3 ) 239 nn_components = 0 ! configuration of the opa-sas OASIS coupling 240 ! =0 no opa-sas OASIS coupling: default single executable configuration 241 ! =1 opa-sas OASIS coupling: multi executable configuration, OPA component 242 ! =2 opa-sas OASIS coupling: multi executable configuration, SAS component 237 243 ln_apr_dyn = .false. ! Patm gradient added in ocean & ice Eqs. (T => fill namsbc_apr ) 238 244 nn_ice = 2 ! =0 no ice boundary condition , … … 342 348 / 343 349 !----------------------------------------------------------------------- 344 &namsbc_cpl ! coupled ocean/atmosphere model ("key_ coupled")350 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 345 351 !----------------------------------------------------------------------- 346 352 ! ! description ! multiple ! vector ! vector ! vector ! … … 932 938 ! = 1 add a tke source below the ML 933 939 ! = 2 add a tke source just at the base of the ML 934 ! = 3 as = 1 applied on HF part of the stress ("key_ coupled")940 ! = 3 as = 1 applied on HF part of the stress ("key_oasis3") 935 941 rn_efr = 0.05 ! fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2) 936 942 nn_htau = 1 ! type of exponential decrease of tke penetration below the ML -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r4990 r5220 97 97 !! - fr_i : ice fraction 98 98 !! - tn_ice : sea-ice surface temperature 99 !! - alb_ice : sea-ice albedo (l k_cpl=T)99 !! - alb_ice : sea-ice albedo (ln_cpl=T) 100 100 !! 101 101 !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. … … 179 179 180 180 ! computation the solar flux at ocean surface 181 IF( l k_cpl ) THEN181 IF( ln_cpl ) THEN 182 182 zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 183 183 ELSE … … 203 203 ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area) 204 204 ! ! coupled mode: 205 IF( l k_cpl ) THEN205 IF( ln_cpl ) THEN 206 206 zemp = + emp_tot(ji,jj) & ! net mass flux over the grid cell (ice+ocean area) 207 207 & - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) ! minus the mass flux intercepted by sea-ice … … 253 253 !-----------------------------------------------! 254 254 255 IF( l k_cpl) THEN255 IF( ln_cpl) THEN 256 256 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature 257 257 ht_i(:,:,1) = hicif(:,:) -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r4990 r5220 217 217 218 218 ! partial computation of the lead energy budget (qldif) 219 IF( l k_cpl ) THEN219 IF( ln_cpl ) THEN 220 220 qldif(ji,jj) = tms(ji,jj) * rdt_ice & 221 221 & * ( ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) ) & … … 291 291 CALL tab_2d_1d_2( nbpb, qns_ice_1d(1:nbpb) , qns_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) 292 292 CALL tab_2d_1d_2( nbpb, dqns_ice_1d(1:nbpb) , dqns_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) 293 IF( .NOT. l k_cpl ) THEN293 IF( .NOT. ln_cpl ) THEN 294 294 CALL tab_2d_1d_2( nbpb, qla_ice_1d (1:nbpb) , qla_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) 295 295 CALL tab_2d_1d_2( nbpb, dqla_ice_1d(1:nbpb) , dqla_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) … … 340 340 CALL tab_1d_2d_2( nbpb, qsr_ice_mean(:,:,1), npb, qsr_ice_mean_1d(1:nbpb) , jpi, jpj ) 341 341 ENDIF 342 IF( .NOT. l k_cpl ) CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb) , jpi, jpj )342 IF( .NOT. ln_cpl ) CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb) , jpi, jpj ) 343 343 ! 344 344 ENDIF … … 441 441 IF( iom_use('qsr_ai_cea' ) ) CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) ) ! Solar flux over the ice [W/m2] 442 442 IF( iom_use('qns_ai_cea' ) ) CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) ) ! Non-solar flux over the ice [W/m2] 443 IF( iom_use('qla_ai_cea' ) .AND. .NOT. l k_cpl ) &443 IF( iom_use('qla_ai_cea' ) .AND. .NOT. ln_cpl ) & 444 444 & CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) ) ! Latent flux over the ice [W/m2] 445 445 ! … … 564 564 IF(lwm) WRITE ( numoni, namicethd ) 565 565 566 IF( l k_cpl .AND. parsub /= 0.0 ) CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' )566 IF( ln_cpl .AND. parsub /= 0.0 ) CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) 567 567 ! 568 568 IF(lwp) THEN ! control print -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
r4990 r5220 18 18 USE ice_2 19 19 USE limistate_2 20 USE sbc_oce, ONLY : l k_cpl20 USE sbc_oce, ONLY : ln_cpl 21 21 USE in_out_manager 22 22 USE lib_mpp ! MPP library … … 337 337 !---------------------------------------------------------------------- 338 338 339 IF ( .NOT. l k_cpl ) THEN ! duplicate the loop for performances issues339 IF ( .NOT. ln_cpl ) THEN ! duplicate the loop for performances issues 340 340 DO ji = kideb, kiut 341 341 sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) ) -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r5187 r5220 94 94 !! - fr_i : ice fraction 95 95 !! - tn_ice : sea-ice surface temperature 96 !! - alb_ice : sea-ice albedo (l k_cpl=T)96 !! - alb_ice : sea-ice albedo (ln_cpl=T) 97 97 !! 98 98 !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. … … 128 128 ! Solar heat flux reaching the ocean = zfcm1 (W.m-2) 129 129 !--------------------------------------------------- 130 IF( l k_cpl ) THEN130 IF( ln_cpl ) THEN 131 131 !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 132 132 zfcm1 = qsr_tot(ji,jj) … … 168 168 ! 169 169 ! computing freshwater exchanges at the ice/ocean interface 170 IF( l k_cpl ) THEN170 IF( ln_cpl ) THEN 171 171 zemp = emp_tot(ji,jj) & ! net mass flux over grid cell 172 172 & - emp_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) & ! minus the mass flux intercepted by sea ice … … 216 216 ! Snow/ice albedo (only if sent to coupler) ! 217 217 !------------------------------------------------! 218 IF( l k_cpl ) THEN ! coupled case218 IF( ln_cpl ) THEN ! coupled case 219 219 220 220 CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os ) -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r5202 r5220 138 138 139 139 !--- Ocean solar and non solar fluxes to be used in zqld 140 IF ( .NOT. l k_cpl ) THEN ! --- forced case, fluxes to the lead are the same as over the ocean140 IF ( .NOT. ln_cpl ) THEN ! --- forced case, fluxes to the lead are the same as over the ocean 141 141 ! 142 142 zqsr(:,:) = qsr(:,:) ; zqns(:,:) = qns(:,:) … … 171 171 ! REMARK valid at least in forced mode from clem 172 172 ! precip is included in qns but not in qns_ice 173 IF ( l k_cpl ) THEN173 IF ( ln_cpl ) THEN 174 174 zqld = tmask(ji,jj,1) * rdt_ice * & 175 175 & ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) & ! pfrld already included in coupled mode … … 576 576 CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 577 577 CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 578 IF( .NOT. l k_cpl ) THEN578 IF( .NOT. ln_cpl ) THEN 579 579 CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 580 580 CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r5202 r5220 280 280 ! clem comment: ice should also sublimate 281 281 zdeltah(:,:) = 0._wp 282 IF( l k_cpl ) THEN282 IF( ln_cpl ) THEN 283 283 ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice) 284 284 zdh_s_sub(:) = 0._wp -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r5202 r5220 24 24 USE wrk_nemo ! work arrays 25 25 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 26 USE sbc_oce, ONLY : l k_cpl26 USE sbc_oce, ONLY : ln_cpl 27 27 28 28 IMPLICIT NONE … … 747 747 DO ji = kideb, kiut 748 748 ! forced mode only : update of latent heat fluxes (sublimation) (always >=0, upward flux) 749 IF( .NOT. l k_cpl) qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_1d(ji) - ztsub(ji) ) )749 IF( .NOT. ln_cpl) qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_1d(ji) - ztsub(ji) ) ) 750 750 ! ! surface ice conduction flux 751 751 isnow(ji) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) ) -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90
r5120 r5220 133 133 ! 134 134 cltxt = '' 135 cxios_context = 'nemo' 135 136 ! 136 137 ! ! Open reference namelist and configuration namelist files … … 162 163 #if defined key_iomput 163 164 IF( Agrif_Root() ) THEN 164 IF( lk_ cpl) THEN165 IF( lk_oasis ) THEN 165 166 CALL cpl_init( ilocal_comm ) ! nemo local communicator given by oasis 166 167 CALL xios_initialize( "oceanx",local_comm=ilocal_comm ) ! send nemo communicator to xios 167 168 ELSE 168 CALL xios_initialize( " nemo",return_comm=ilocal_comm ) ! nemo local communicator given by xios169 CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios 169 170 ENDIF 170 171 ENDIF … … 172 173 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 173 174 #else 174 IF( lk_ cpl) THEN175 IF( lk_oasis ) THEN 175 176 IF( Agrif_Root() ) THEN 176 177 CALL cpl_init( ilocal_comm ) ! nemo local communicator given by oasis -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r5217 r5220 593 593 ENDIF 594 594 595 IF( .NOT. l k_cpl ) THEN595 IF( .NOT. ln_cpl ) THEN 596 596 CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp 597 597 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) … … 602 602 ENDIF 603 603 604 IF( l k_cpl .AND. nn_ice <= 1 ) THEN604 IF( ln_cpl .AND. nn_ice <= 1 ) THEN 605 605 CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp 606 606 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) … … 625 625 #endif 626 626 627 IF( l k_cpl .AND. nn_ice == 2 ) THEN627 IF( ln_cpl .AND. nn_ice == 2 ) THEN 628 628 CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature" , "K" , & ! tn_ice 629 629 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) … … 780 780 ENDIF 781 781 782 IF( .NOT. l k_cpl ) THEN782 IF( .NOT. ln_cpl ) THEN 783 783 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 784 784 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping … … 786 786 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 787 787 ENDIF 788 IF( l k_cpl .AND. nn_ice <= 1 ) THEN788 IF( ln_cpl .AND. nn_ice <= 1 ) THEN 789 789 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 790 790 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping … … 802 802 #endif 803 803 804 IF( l k_cpl .AND. nn_ice == 2 ) THEN804 IF( ln_cpl .AND. nn_ice == 2 ) THEN 805 805 CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT ) ! surf. ice temperature 806 806 CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT ) ! ice albedo -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r4990 r5220 142 142 LOGICAL :: lwp = .FALSE. !: boolean : true on the 1st processor only .OR. ln_ctl 143 143 LOGICAL :: lsp_area = .TRUE. !: to make a control print over a specific area 144 CHARACTER(lc) :: cxios_context !: context name used in xios 144 145 145 146 !!---------------------------------------------------------------------- -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r4990 r5220 61 61 #endif 62 62 63 INTEGER, PUBLIC, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields 63 INTEGER :: nrcv ! total number of fields received 64 INTEGER :: nsnd ! total number of fields sent 65 INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 66 INTEGER, PUBLIC, PARAMETER :: nmaxfld=50 ! Maximum number of coupling fields 64 67 INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 65 68 INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields … … 86 89 CONTAINS 87 90 88 SUBROUTINE cpl_init( kl_comm )91 SUBROUTINE cpl_init( cd_modname, kl_comm ) 89 92 !!------------------------------------------------------------------- 90 93 !! *** ROUTINE cpl_init *** … … 95 98 !! ** Method : OASIS3 MPI communication 96 99 !!-------------------------------------------------------------------- 97 INTEGER, INTENT(out) :: kl_comm ! local communicator of the model 100 CHARACTER(len = *), INTENT(in) :: cd_modname ! model name as set in namcouple file 101 INTEGER , INTENT(out) :: kl_comm ! local communicator of the model 98 102 !!-------------------------------------------------------------------- 99 103 … … 104 108 ! 1st Initialize the OASIS system for the application 105 109 !------------------------------------------------------------------ 106 CALL oasis_init_comp ( ncomp_id, 'oceanx', nerror )110 CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror ) 107 111 IF ( nerror /= OASIS_Ok ) & 108 112 CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') … … 144 148 IF(lwp) WRITE(numout,*) 145 149 150 ncplmodel = kcplmodel 146 151 IF( kcplmodel > nmaxcpl ) THEN 147 CALL oasis_abort ( ncomp_id, 'cpl_define', ' kcplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN152 CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN 148 153 ENDIF 154 155 nrcv = krcv 156 IF( nrcv > nmaxfld ) THEN 157 CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld') ; RETURN 158 ENDIF 159 160 nsnd = ksnd 161 IF( nsnd > nmaxfld ) THEN 162 CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld') ; RETURN 163 ENDIF 164 149 165 ! 150 166 ! ... Define the shape for the area that excludes the halo … … 400 416 401 417 402 INTEGER FUNCTION cpl_freq( kid)418 INTEGER FUNCTION cpl_freq( cdfieldname ) 403 419 !!--------------------------------------------------------------------- 404 420 !! *** ROUTINE cpl_freq *** … … 406 422 !! ** Purpose : - send back the coupling frequency for a particular field 407 423 !!---------------------------------------------------------------------- 408 INTEGER,INTENT(in) :: kid ! variable index 409 !! 424 CHARACTER(len = *), INTENT(in) :: cdfieldname ! field name as set in namcouple file 425 !! 426 INTEGER :: id 410 427 INTEGER :: info 411 428 INTEGER, DIMENSION(1) :: itmp 429 INTEGER :: ji,jm ! local loop index 412 430 !!---------------------------------------------------------------------- 413 CALL oasis_get_freqs(kid, 1, itmp, info) 414 cpl_freq = itmp(1) 431 cpl_freq = 0 ! defaut definition 432 id = -1 ! defaut definition 433 ! 434 DO ji = 1, nsnd 435 DO jm = 1, ncplmodel 436 IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN 437 IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) id = ssnd(ji)%nid(1,jm) 438 ENDIF 439 ENDDO 440 ENDDO 441 DO ji = 1, nrcv 442 DO jm = 1, ncplmodel 443 IF( srcv(ji)%nid(1,jm) /= -1 ) THEN 444 IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) id = srcv(ji)%nid(1,jm) 445 ENDIF 446 ENDDO 447 ENDDO 448 ! 449 IF( id /= -1 ) THEN 450 CALL oasis_get_freqs(id, 1, itmp, info) 451 cpl_freq = itmp(1) 452 ENDIF 415 453 ! 416 454 END FUNCTION cpl_freq -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r5132 r5220 154 154 IF( PRESENT(kit) ) ll_firstcall = ll_firstcall .and. kit == 1 155 155 156 it_offset = 0 156 IF ( nn_components == jp_iam_sas ) THEN ; it_offset = nn_fsbc 157 ELSE ; it_offset = 0 158 ENDIF 157 159 IF( PRESENT(kt_offset) ) it_offset = kt_offset 158 160 … … 452 454 ENDIF 453 455 ! 454 it_offset = 0 456 IF ( nn_components == jp_iam_sas ) THEN ; it_offset = nn_fsbc 457 ELSE ; it_offset = 0 458 ENDIF 455 459 IF( PRESENT(kt_offset) ) it_offset = kt_offset 456 460 IF( PRESENT(kit) ) THEN ; it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) ) -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r5123 r5220 145 145 a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 146 146 STAT= ierr(1) ) 147 IF( l k_cpl ) ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , &147 IF( ln_cpl ) ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , & 148 148 & v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1) , & 149 149 & emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , & … … 157 157 ! 158 158 #if defined key_cice || defined key_lim2 159 IF( l k_cpl ) ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) )159 IF( ln_cpl ) ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 160 160 #endif 161 161 -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r5120 r5220 35 35 LOGICAL , PUBLIC :: ln_blk_core !: CORE bulk formulation 36 36 LOGICAL , PUBLIC :: ln_blk_mfs !: MFS bulk formulation 37 LOGICAL , PUBLIC :: ln_mixcpl !: forced-coupled mixed formulation 37 38 #if defined key_oasis3 38 LOGICAL , PUBLIC :: lk_ cpl = .TRUE. !: coupled formulation39 LOGICAL , PUBLIC :: lk_oasis = .TRUE. !: OASIS used 39 40 #else 40 LOGICAL , PUBLIC :: lk_cpl = .FALSE. !: coupled formulation 41 #endif 41 LOGICAL , PUBLIC :: lk_oasis = .FALSE. !: OASIS unused 42 #endif 43 LOGICAL , PUBLIC :: ln_cpl !: coupled formulation 42 44 LOGICAL , PUBLIC :: ln_dm2dc !: Daily mean to Diurnal Cycle short wave (qsr) 43 45 LOGICAL , PUBLIC :: ln_rnf !: runoffs / runoff mouths … … 50 52 ! !: =1 levitating ice with mass and salt exchange but no presure effect 51 53 ! !: =2 embedded sea-ice (full salt and mass exchanges and pressure) 52 INTEGER , PUBLIC :: nn_limflx !: LIM3 Multi-category heat flux formulation 54 INTEGER , PUBLIC :: nn_components !: flag for sbc module (including sea-ice) coupling mode (see component definition below) 55 INTEGER , PUBLIC :: nn_limflx !: LIM3 Multi-category heat flux formulation 53 56 ! !: =-1 Use of per-category fluxes 54 57 ! !: = 0 Average per-category fluxes … … 76 79 INTEGER , PUBLIC, PARAMETER :: jp_cpl = 5 !: Coupled formulation 77 80 INTEGER , PUBLIC, PARAMETER :: jp_mfs = 6 !: MFS bulk formulation 81 INTEGER , PUBLIC, PARAMETER :: jp_none = 7 !: coupling via SAS module 78 82 INTEGER , PUBLIC, PARAMETER :: jp_esopa = -1 !: esopa test, ALL formulations 79 83 84 !!---------------------------------------------------------------------- 85 !! component definition 86 !!---------------------------------------------------------------------- 87 INTEGER , PUBLIC, PARAMETER :: jp_iam_nemo = 0 !: Initial single executable configuration 88 ! (no internal OASIS coupling) 89 INTEGER , PUBLIC, PARAMETER :: jp_iam_opa = 1 !: Multi executable configuration - OPA component 90 ! (internal OASIS coupling) 91 INTEGER , PUBLIC, PARAMETER :: jp_iam_sas = 2 !: Multi executable configuration - SAS component 92 ! (internal OASIS coupling) 80 93 !!---------------------------------------------------------------------- 81 94 !! Ocean Surface Boundary Condition fields … … 111 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: atm_co2 !: atmospheric pCO2 [ppm] 112 125 #endif 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask !: coupling mask (warning: allocated in sbccpl) 113 127 114 128 !!---------------------------------------------------------------------- -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5146 r5220 21 21 USE sbc_oce ! Surface boundary condition: ocean fields 22 22 USE sbc_ice ! Surface boundary condition: ice fields 23 USE sbcapr 23 24 USE sbcdcy ! surface boundary condition: diurnal cycle 24 25 USE phycst ! physical constants … … 32 33 USE cpl_oasis3 ! OASIS3 coupling 33 34 USE geo2ocean ! 34 USE oce , ONLY : tsn, un, vn 35 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, tsb, sshb 35 36 USE albedo ! 36 37 USE in_out_manager ! I/O manager … … 40 41 USE timing ! Timing 41 42 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 43 USE eosbn2 42 44 #if defined key_cpl_carbon_cycle 43 45 USE p4zflx, ONLY : oce_co2 … … 48 50 IMPLICIT NONE 49 51 PRIVATE 50 !EM XIOS-OASIS-MCT compliance 52 51 53 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 52 54 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90 … … 89 91 INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn 90 92 INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn 91 INTEGER, PARAMETER :: jprcv = 33 ! total number of fields received 93 INTEGER, PARAMETER :: jpr_sflx = 34 ! salt flux 94 INTEGER, PARAMETER :: jpr_toce = 35 ! ocean temperature 95 INTEGER, PARAMETER :: jpr_soce = 36 ! ocean salinity 96 INTEGER, PARAMETER :: jpr_ocx1 = 37 ! ocean current on grid 1 97 INTEGER, PARAMETER :: jpr_ocy1 = 38 ! 98 INTEGER, PARAMETER :: jpr_ssh = 39 ! sea surface height 99 INTEGER, PARAMETER :: jpr_fice = 40 ! ice fraction 100 INTEGER, PARAMETER :: jprcv = 40 ! total number of fields received 92 101 93 102 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction … … 106 115 INTEGER, PARAMETER :: jps_ivz1 = 14 ! 107 116 INTEGER, PARAMETER :: jps_co2 = 15 108 INTEGER, PARAMETER :: jpsnd = 15 ! total number of fields sended 117 INTEGER, PARAMETER :: jps_soce = 16 ! ocean salinity 118 INTEGER, PARAMETER :: jps_ssh = 17 ! sea surface height 119 INTEGER, PARAMETER :: jps_qsroce = 18 ! Qsr above the ocean 120 INTEGER, PARAMETER :: jps_qnsoce = 19 ! Qns above the ocean 121 INTEGER, PARAMETER :: jps_oemp = 20 ! ocean freshwater budget (evap - precip) 122 INTEGER, PARAMETER :: jps_sflx = 21 ! salt flux 123 INTEGER, PARAMETER :: jps_otx1 = 22 ! 2 atmosphere-ocean stress components on grid 1 124 INTEGER, PARAMETER :: jps_oty1 = 23 ! 125 INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs 126 INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module 127 INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent twice if atmos and ice coupled via OASIS 128 INTEGER, PARAMETER :: jpsnd = 26 ! total number of fields sended 109 129 110 130 ! !!** namelist namsbc_cpl ** … … 125 145 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 126 146 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 127 128 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask129 130 147 TYPE :: DYNARR 131 148 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 … … 161 178 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 162 179 #endif 163 ALLOCATE( xcplmask(jpi,jpj, nn_cplmodel) , STAT=ierr(3) )180 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 164 181 ! 165 182 sbc_cpl_alloc = MAXVAL( ierr ) … … 182 199 !! * initialise the OASIS coupler 183 200 !!---------------------------------------------------------------------- 184 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)201 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 185 202 !! 186 203 INTEGER :: jn ! dummy loop index … … 212 229 IF(lwm) WRITE ( numond, namsbc_cpl ) 213 230 214 IF(lwp ) THEN ! control print231 IF(lwp .AND. nn_components /= jp_iam_opa ) THEN ! control print 215 232 WRITE(numout,*) 216 233 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' … … 359 376 srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip 360 377 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 378 CASE( 'none' ) ! nothing to do 361 379 CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE. 362 380 CASE( 'conservative' ) … … 384 402 srcv(jpr_qnsmix)%clname = 'O_QnsMix' 385 403 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 404 CASE( 'none' ) ! nothing to do 386 405 CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE. 387 406 CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. … … 399 418 srcv(jpr_qsrmix)%clname = 'O_QsrMix' 400 419 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 420 CASE( 'none' ) ! nothing to do 401 421 CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE. 402 422 CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. … … 414 434 ! 415 435 ! non solar sensitivity mandatory for LIM ice model 416 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 ) &436 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) & 417 437 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 418 438 ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique … … 447 467 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 448 468 ENDIF 449 469 ! ! ------------------------------- ! 470 ! ! OPA-SAS coupling - rcv by opa ! 471 ! ! ------------------------------- ! 472 srcv(jpr_sflx)%clname = 'O_SFLX' 473 srcv(jpr_fice)%clname = 'RIceFrc' 474 ! ! -------------------------------- ! 475 ! ! OPA-SAS coupling - rcv by sas ! 476 ! ! -------------------------------- ! 477 srcv(jpr_toce)%clname = 'I_SSTSST' 478 srcv(jpr_soce)%clname = 'I_SSSal' 479 srcv(jpr_ocx1)%clname = 'I_OCurx1' 480 srcv(jpr_ocy1)%clname = 'I_OCury1' 481 srcv(jpr_ssh)%clname = 'I_SSHght' 482 483 IF( nn_components == jp_iam_opa ) THEN ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS) 484 srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 485 srcv(jpr_fice )%laction = .TRUE. 486 srcv( (/jpr_taum, jpr_otx1, jpr_oty1 /) )%laction = .TRUE. 487 srcv(jpr_otx1)%clgrid = 'U' ! oce components given at U-point 488 srcv(jpr_oty1)%clgrid = 'V' ! and V-point 489 sn_rcv_tau%clvgrd = 'U,V' 490 sn_rcv_tau%clvor = 'local grid' 491 sn_rcv_tau%clvref = 'spherical' 492 srcv( (/jpr_qsroce, jpr_qnsoce /) )%laction = .TRUE. 493 srcv( (/jpr_oemp, jpr_sflx/) )%laction = .TRUE. 494 sn_rcv_emp%cldes = 'oce only' 495 IF(lwp) THEN ! control print 496 WRITE(numout,*) 497 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 498 WRITE(numout,*)' Special conditions for SAS-OPA coupling ' 499 WRITE(numout,*)' OPA component ' 500 WRITE(numout,*) 501 WRITE(numout,*)' received fields from SAS component ' 502 WRITE(numout,*)' ice cover ' 503 WRITE(numout,*)' oce only EMP ' 504 WRITE(numout,*)' salt flux ' 505 WRITE(numout,*)' mixed oce-ice solar flux ' 506 WRITE(numout,*)' mixed oce-ice non solar flux ' 507 WRITE(numout,*)' wind stress U,V on local grid and sperical coordinates ' 508 WRITE(numout,*)' wind stress module' 509 WRITE(numout,*) 510 ENDIF 511 ELSE IF( nn_components == jp_iam_sas ) THEN 512 IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 513 srcv(jpr_toce )%laction = .TRUE. ; srcv(jpr_soce )%laction = .TRUE. ; srcv(jpr_ocx1 )%laction = .TRUE. ; 514 srcv(jpr_ocy1 )%laction = .TRUE. ; srcv(jpr_ssh )%laction = .TRUE. 515 ! Vectors: change of sign at north fold ONLY if on the local grid 516 srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1. 517 ! Change first letter to couple with atmosphere if already coupled with sea_ice 518 DO jn = 1, jprcv 519 IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 520 END DO 521 IF(lwp) THEN ! control print 522 IF( .NOT. ln_cpl ) THEN 523 WRITE(numout,*) 524 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 525 WRITE(numout,*)' Special conditions for SAS-OPA coupling ' 526 WRITE(numout,*)' SAS component ' 527 WRITE(numout,*) 528 WRITE(numout,*)' received fields from OPA component ' 529 ELSE 530 WRITE(numout,*) 531 WRITE(numout,*)' Special conditions for SAS-OPA coupling ' 532 WRITE(numout,*)' SAS component ' 533 WRITE(numout,*) 534 WRITE(numout,*)' Additional received fields from OPA component : ' 535 ENDIF 536 WRITE(numout,*)' sea surface temperature (T before, Celcius) ' 537 WRITE(numout,*)' sea surface salinity ' 538 WRITE(numout,*)' surface currents ' 539 WRITE(numout,*)' sea surface height ' 540 WRITE(numout,*) 541 ENDIF 542 ENDIF 450 543 ! Allocate all parts of frcv used for received fields 451 544 DO jn = 1, jprcv … … 454 547 ! Allocate taum part of frcv which is used even when not received as coupling field 455 548 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 549 ! Allocate w10m part of frcv which is used even when not received as coupling field 550 IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 456 551 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 457 552 IF( k_ice /= 0 ) THEN … … 485 580 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 486 581 END SELECT 487 582 488 583 ! ! ------------------------- ! 489 584 ! ! Albedo ! … … 518 613 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 519 614 ENDIF 520 615 521 616 SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 522 617 CASE( 'none' ) ! nothing to do … … 567 662 ! ! ------------------------- ! 568 663 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 664 665 ! ! ------------------------------- ! 666 ! ! OPA-SAS coupling - snd by opa ! 667 ! ! ------------------------------- ! 668 ssnd(jps_ssh )%clname = 'O_SSHght' 669 ssnd(jps_soce)%clname = 'O_SSSal' 670 ! ! ------------------------------- ! 671 ! ! OPA-SAS coupling - snd by sas ! 672 ! ! ------------------------------- ! 673 ssnd(jps_sflx )%clname = 'I_SFLX' 674 ssnd(jps_fice2 )%clname = 'IIceFrc' 675 ssnd(jps_qsroce)%clname = 'I_QsrOce' 676 ssnd(jps_qnsoce)%clname = 'I_QnsOce' 677 ssnd(jps_oemp )%clname = 'IOEvaMPr' 678 ssnd(jps_otx1 )%clname = 'I_OTaux1' 679 ssnd(jps_oty1 )%clname = 'I_OTauy1' 680 ssnd(jps_rnf )%clname = 'I_Runoff' 681 ssnd(jps_taum )%clname = 'I_TauMod' 682 683 ! NEMO coupled to sea ice with OASIS 684 IF( nn_components == jp_iam_opa ) THEN 685 ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 686 ssnd( jps_ssh )%laction = .TRUE. ; ssnd(jps_soce)%laction = .TRUE. 687 ssnd( jps_toce )%laction = .TRUE. ; ssnd( (/jps_ocx1,jps_ocy1/) )%laction = .TRUE. 688 ssnd(jps_ocx1)%clgrid = 'U' ! oce components given at U-point 689 ssnd(jps_ocy1)%clgrid = 'V' ! and V-point 690 sn_snd_crt%clvgrd = 'U,V' 691 sn_snd_crt%clvor = 'local grid' 692 sn_snd_crt%clvref = 'spherical' 693 IF(lwp) THEN ! control print 694 WRITE(numout,*) 695 WRITE(numout,*)' sent fields to SAS component ' 696 WRITE(numout,*)' sea surface temperature (T before, Celcius) ' 697 WRITE(numout,*)' sea surface salinity ' 698 WRITE(numout,*)' surface currents U,V on local grid and spherical coordinates' 699 WRITE(numout,*)' sea surface height ' 700 WRITE(numout,*) 701 ENDIF 702 ! Sea ice coupled to NEMO with OASIS 703 ELSE IF( nn_components == jp_iam_sas ) THEN 704 IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 705 ssnd(jps_qsroce)%laction = .TRUE. ; ssnd(jps_qnsoce)%laction = .TRUE. ; ssnd(jps_oemp)%laction = .TRUE. 706 ssnd(jps_sflx )%laction = .TRUE. ; ssnd(jps_otx1 )%laction = .TRUE. ; ssnd(jps_oty1)%laction = .TRUE. 707 ssnd(jps_taum )%laction = .TRUE. 708 ssnd(jps_fice2)%laction = .TRUE. ! fr_i defined in sas, even if nn_ice == 0 709 sn_snd_thick%clcat = 'no' 710 IF (.NOT. ln_cpl) ssnd(jps_fice)%laction = .FALSE. 711 ! Change first letter to couple with atmosphere if already coupled with sea_ice 712 DO jn = 1, jpsnd 713 IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 714 END DO 715 IF(lwp) THEN ! control print 716 IF( .NOT. ln_cpl ) THEN 717 WRITE(numout,*) 718 WRITE(numout,*)' sent fields to OPA component ' 719 ELSE 720 WRITE(numout,*) 721 WRITE(numout,*)' Additional sent fields to OPA component : ' 722 WRITE(numout,*)' ice cover ' 723 WRITE(numout,*)' oce only EMP ' 724 WRITE(numout,*)' salt flux ' 725 WRITE(numout,*)' mixed oce-ice solar flux ' 726 WRITE(numout,*)' mixed oce-ice non solar flux ' 727 WRITE(numout,*)' wind stress U,V components' 728 WRITE(numout,*)' wind stress module' 729 ENDIF 730 ENDIF 731 ENDIF 732 569 733 ! 570 734 ! ================================ ! … … 572 736 ! ================================ ! 573 737 574 CALL cpl_define(jprcv, jpsnd, nn_cplmodel)738 CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 575 739 IF (ln_usecplmask) THEN 576 740 xcplmask(:,:,:) = 0. … … 582 746 xcplmask(:,:,:) = 1. 583 747 ENDIF 584 ! 585 IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) ) & 748 xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 749 ! 750 IF( ln_dm2dc .AND. & 751 & ( cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'S_QsrOce' ) + cpl_freq( 'S_QsrMix' ) ) /= 86400 ) & 586 752 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 587 753 … … 638 804 !! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 639 805 !!---------------------------------------------------------------------- 640 INTEGER, INTENT(in) :: kt ! ocean model time step index 641 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 642 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 643 !! 644 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 806 INTEGER, INTENT(in) :: kt ! ocean model time step index 807 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 808 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 809 810 !! 811 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 645 812 INTEGER :: ji, jj, jn ! dummy loop indices 646 813 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) … … 650 817 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 651 818 REAL(wp) :: zzx, zzy ! temporary variables 652 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty 819 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr 653 820 !!---------------------------------------------------------------------- 654 821 ! 655 822 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 656 823 ! 657 CALL wrk_alloc( jpi,jpj, ztx, zty ) 658 ! ! Receive all the atmos. fields (including ice information) 659 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 660 DO jn = 1, jprcv ! received fields sent by the atmosphere 661 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) ) 824 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 825 ! 826 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 827 ! 828 ! ! ======================================================= ! 829 ! ! Receive all the atmos. fields (including ice information) 830 ! ! ======================================================= ! 831 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 832 DO jn = 1, jprcv ! received fields sent by the atmosphere 833 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 662 834 END DO 663 835 … … 761 933 !CDIR NOVERRCHK 762 934 DO ji = 1, jpi 763 wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )935 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 764 936 END DO 765 937 END DO 766 938 ENDIF 767 ELSE768 IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)769 939 ENDIF 770 940 … … 773 943 IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 774 944 ! 775 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 776 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 777 taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 945 IF( ln_mixcpl ) THEN 946 utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:) 947 vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:) 948 taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:) 949 wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:) 950 ELSE 951 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 952 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 953 taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 954 wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 955 ENDIF 778 956 CALL iom_put( "taum_oce", taum ) ! output wind stress module 779 957 ! … … 781 959 782 960 #if defined key_cpl_carbon_cycle 783 ! ! atmosph. CO2 (ppm) 961 ! ! ================== ! 962 ! ! atmosph. CO2 (ppm) ! 963 ! ! ================== ! 784 964 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 785 965 #endif 786 966 967 ! Fields received by ice model when OASIS coupling 968 ! (arrays no more filled at sbcssm stage) 969 ! ! ================== ! 970 ! ! SST ! 971 ! ! ================== ! 972 IF( srcv(jpr_toce)%laction ) THEN ! received by sas in case of opa <-> sas coupling 973 sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1) 974 tsn(:,:,1,jp_tem) = sst_m(:,:) 975 ENDIF 976 ! ! ================== ! 977 ! ! SSS ! 978 ! ! ================== ! 979 IF( srcv(jpr_soce)%laction ) THEN ! received by sas in case of opa <-> sas coupling 980 sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1) 981 tsn(:,:,1,jp_sal) = sss_m(:,:) 982 ENDIF 983 ! ! ================== ! 984 ! ! SSH ! 985 ! ! ================== ! 986 IF( srcv(jpr_ssh )%laction ) ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1) 987 988 ! ! ================== ! 989 ! ! surface currents ! 990 ! ! ================== ! 991 IF( srcv(jpr_ocx1)%laction ) THEN 992 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 993 ub (:,:,1 ) = ssu_m(:,:) 994 ENDIF 995 IF( srcv(jpr_ocy1)%laction ) THEN 996 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 997 vb (:,:,1 ) = ssv_m(:,:) 998 ENDIF 999 787 1000 ! ! ========================= ! 788 IF( k_ice <= 1 ) THEN! heat & freshwater fluxes ! (Ocean only case)1001 IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN ! heat & freshwater fluxes ! (Ocean only case) 789 1002 ! ! ========================= ! 790 1003 ! 791 1004 ! ! total freshwater fluxes over the ocean (emp) 792 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 793 CASE( 'conservative' ) 794 emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 795 CASE( 'oce only', 'oce and ice' ) 796 emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 797 CASE default 798 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 799 END SELECT 1005 IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN 1006 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 1007 CASE( 'conservative' ) 1008 zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 1009 CASE( 'oce only', 'oce and ice' ) 1010 zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 1011 CASE default 1012 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 1013 END SELECT 1014 ELSE 1015 zemp(:,:) = 0._wp 1016 ENDIF 800 1017 ! 801 1018 ! ! runoffs and calving (added in emp) 802 IF( srcv(jpr_rnf)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 803 IF( srcv(jpr_cal)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 804 ! 805 !!gm : this seems to be internal cooking, not sure to need that in a generic interface 806 !!gm at least should be optional... 807 !! IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN ! add to the total freshwater budget 808 !! ! remove negative runoff 809 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 810 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 811 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) ! sum over the global domain 812 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 813 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 814 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 815 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 816 !! ENDIF 817 !! ! add runoff to e-p 818 !! emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 819 !! ENDIF 820 !!gm end of internal cooking 1019 IF( srcv(jpr_rnf)%laction ) zemp(:,:) = zemp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 1020 IF( srcv(jpr_cal)%laction ) zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 1021 1022 IF( ln_mixcpl ) THEN ; emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 1023 ELSE ; emp(:,:) = zemp(:,:) 1024 ENDIF 821 1025 ! 822 1026 ! ! non solar heat flux over the ocean (qns) 823 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 824 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1027 IF( srcv(jpr_qnsoce)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1028 ELSE IF( srcv(jpr_qnsmix)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1029 ELSE ; zqns(:,:) = 0._wp 1030 END IF 825 1031 ! update qns over the free ocean with: 826 qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp! remove heat content due to mass flux (assumed to be at SST)1032 zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 827 1033 IF( srcv(jpr_snow )%laction ) THEN 828 qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean 1034 zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean 1035 ENDIF 1036 IF( ln_mixcpl ) THEN ; qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) 1037 ELSE ; qns(:,:) = zqns(:,:) 829 1038 ENDIF 830 1039 831 1040 ! ! solar flux over the ocean (qsr) 832 IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 833 IF( srcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 834 IF( ln_dm2dc ) qsr(:,:) = sbc_dcy( qsr ) ! modify qsr to include the diurnal cycle 1041 IF ( srcv(jpr_qsroce)%laction ) THEN ; zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 1042 ELSE IF( srcv(jpr_qsrmix)%laction ) then ; zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 1043 ELSE ; zqsr(:,:) = 0._wp 1044 ENDIF 1045 IF( ln_dm2dc ) zqsr(:,:) = sbc_dcy( zqsr ) ! modify qsr to include the diurnal cycle 1046 IF( ln_mixcpl ) THEN ; qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:) 1047 ELSE ; qsr(:,:) = zqsr(:,:) 1048 ENDIF 835 1049 ! 836 837 ENDIF 838 ! 839 CALL wrk_dealloc( jpi,jpj, ztx, zty ) 1050 ! salt flux over the ocean (received by opa in case of opa <-> sas coupling) 1051 IF( srcv(jpr_sflx )%laction ) sfx(:,:) = frcv(jpr_sflx )%z3(:,:,1) 1052 ! Ice cover (received by opa in case of opa <-> sas coupling) 1053 IF( srcv(jpr_fice )%laction ) fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 1054 ! 1055 1056 ENDIF 1057 ! 1058 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 840 1059 ! 841 1060 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') … … 1056 1275 1057 1276 1058 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist)1277 SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist ) 1059 1278 !!---------------------------------------------------------------------- 1060 1279 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1098 1317 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1099 1318 ! optional arguments, used only in 'mixed oce-ice' case 1100 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1101 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1102 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1103 ! 1104 INTEGER :: jl ! dummy loop index 1105 REAL(wp), POINTER, DIMENSION(:,:) :: zcptn, ztmp, zicefr 1319 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1320 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1321 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1322 ! 1323 INTEGER :: jl ! dummy loop index 1324 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk 1325 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot 1326 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice 1106 1327 !!---------------------------------------------------------------------- 1107 1328 ! 1108 1329 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1109 1330 ! 1110 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr ) 1111 1331 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1332 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1333 1334 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 1112 1335 zicefr(:,:) = 1.- p_frld(:,:) 1113 1336 zcptn(:,:) = rcp * sst_m(:,:) … … 1117 1340 ! ! ========================= ! 1118 1341 ! 1119 ! ! total Precipitations - total Evaporation (emp_tot) 1120 ! ! solid precipitation - sublimation (emp_ice) 1121 ! ! solid Precipitation (sprecip) 1342 ! ! total Precipitation - total Evaporation (emp_tot) 1343 ! ! solid precipitation - sublimation (emp_ice) 1344 ! ! solid Precipitation (sprecip) 1345 ! ! liquid + solid Precipitation (tprecip) 1122 1346 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1123 1347 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1124 sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)! May need to ensure positive here1125 tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:)! May need to ensure positive here1126 emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) -tprecip(:,:)1127 emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)1348 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1349 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1350 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1351 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1128 1352 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1129 1353 IF( iom_use('hflx_rain_cea') ) & … … 1136 1360 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) ) ! heat flux from from evap (cell average) 1137 1361 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1138 emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1139 emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1140 sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 1362 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1363 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1364 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1365 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 1141 1366 END SELECT 1367 1368 IF( iom_use('subl_ai_cea') ) & 1369 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1370 ! 1371 ! ! runoffs and calving (put in emp_tot) 1372 IF( srcv(jpr_rnf)%laction ) THEN 1373 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 1374 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers 1375 IF( iom_use('hflx_rnf_cea') ) & 1376 CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers 1377 ENDIF 1378 IF( srcv(jpr_cal)%laction ) THEN 1379 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1380 CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) ) 1381 ENDIF 1382 1383 IF( ln_mixcpl ) THEN 1384 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1385 emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1386 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1387 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1388 ELSE 1389 emp_tot(:,:) = zemp_tot(:,:) 1390 emp_ice(:,:) = zemp_ice(:,:) 1391 sprecip(:,:) = zsprecip(:,:) 1392 tprecip(:,:) = ztprecip(:,:) 1393 ENDIF 1142 1394 1143 1395 CALL iom_put( 'snowpre' , sprecip ) ! Snow … … 1146 1398 IF( iom_use('snow_ai_cea') ) & 1147 1399 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1148 IF( iom_use('subl_ai_cea') ) &1149 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average)1150 !1151 ! ! runoffs and calving (put in emp_tot)1152 IF( srcv(jpr_rnf)%laction ) THEN1153 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)1154 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers1155 IF( iom_use('hflx_rnf_cea') ) &1156 CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers1157 ENDIF1158 IF( srcv(jpr_cal)%laction ) THEN1159 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)1160 CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) )1161 ENDIF1162 !1163 !!gm : this seems to be internal cooking, not sure to need that in a generic interface1164 !!gm at least should be optional...1165 !! ! remove negative runoff ! sum over the global domain1166 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1167 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1168 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos )1169 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg )1170 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points1171 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos1172 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg1173 !! ENDIF1174 !! emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) ! add runoff to e-p1175 !!1176 !!gm end of internal cooking1177 1400 1178 1401 ! ! ========================= ! … … 1180 1403 ! ! ========================= ! 1181 1404 CASE( 'oce only' ) ! the required field is directly provided 1182 qns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1)1405 zqns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1) 1183 1406 CASE( 'conservative' ) ! the required fields are directly provided 1184 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)1407 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1185 1408 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1186 qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)1409 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1187 1410 ELSE 1188 1411 ! Set all category values equal for the moment 1189 1412 DO jl=1,jpl 1190 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)1413 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1191 1414 ENDDO 1192 1415 ENDIF 1193 1416 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1194 qns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)1417 zqns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1195 1418 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1196 1419 DO jl=1,jpl 1197 qns_tot(:,: ) =qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)1198 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)1420 zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) 1421 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 1199 1422 ENDDO 1200 1423 ELSE 1201 1424 qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1202 1425 DO jl=1,jpl 1203 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1426 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1427 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1204 1428 ENDDO 1205 1429 ENDIF 1206 1430 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1207 1431 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1208 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)1209 qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) &1432 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1433 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1210 1434 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1211 1435 & + pist(:,:,1) * zicefr(:,:) ) ) 1212 1436 END SELECT 1213 ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus1214 qns_tot(:,:) = qns_tot(:,:) & !qns_tot update over free ocean with:1437 ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 1438 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1215 1439 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting 1216 & - ( emp_tot(:,:)& ! remove the heat content of mass flux (assumed to be at SST)1217 & - emp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:)1440 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1441 & - zemp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:) 1218 1442 IF( iom_use('hflx_snow_cea') ) & 1219 1443 CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1220 1444 !!gm 1221 !! currently it is taken into account in leads budget but not in the qns_tot, and thus not in1445 !! currently it is taken into account in leads budget but not in the zqns_tot, and thus not in 1222 1446 !! the flux that enter the ocean.... 1223 1447 !! moreover 1 - it is not diagnose anywhere.... … … 1228 1452 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1229 1453 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1230 qns_tot(:,:) =qns_tot(:,:) - ztmp(:,:)1454 zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 1231 1455 IF( iom_use('hflx_cal_cea') ) & 1232 1456 CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1457 ENDIF 1458 1459 IF( ln_mixcpl ) THEN 1460 qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1461 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 1462 DO jl=1,jpl 1463 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1464 ENDDO 1465 ELSE 1466 qns_tot(:,: ) = zqns_tot(:,: ) 1467 qns_ice(:,:,:) = zqns_ice(:,:,:) 1233 1468 ENDIF 1234 1469 … … 1237 1472 ! ! ========================= ! 1238 1473 CASE( 'oce only' ) 1239 qsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )1474 zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 1240 1475 CASE( 'conservative' ) 1241 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1476 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1242 1477 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1243 qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)1478 zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 1244 1479 ELSE 1245 1480 ! Set all category values equal for the moment 1246 1481 DO jl=1,jpl 1247 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)1482 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1248 1483 ENDDO 1249 1484 ENDIF 1250 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1251 qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)1485 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1486 zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1252 1487 CASE( 'oce and ice' ) 1253 qsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)1488 zqsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1254 1489 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1255 1490 DO jl=1,jpl 1256 qsr_tot(:,: ) =qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)1257 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)1491 zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) 1492 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 1258 1493 ENDDO 1259 1494 ELSE 1260 1495 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1261 1496 DO jl=1,jpl 1262 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1497 zqsr_tot(:,: ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1498 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1263 1499 ENDDO 1264 1500 ENDIF 1265 1501 CASE( 'mixed oce-ice' ) 1266 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1502 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1267 1503 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1268 1504 ! Create solar heat flux over ice using incoming solar heat flux and albedos 1269 1505 ! ( see OASIS3 user guide, 5th edition, p39 ) 1270 qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) &1506 zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1271 1507 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) & 1272 1508 & + palbi (:,:,1) * zicefr(:,:) ) ) 1273 1509 END SELECT 1274 1510 IF( ln_dm2dc ) THEN ! modify qsr to include the diurnal cycle 1275 qsr_tot(:,: ) = sbc_dcy(qsr_tot(:,: ) )1511 zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) ) 1276 1512 DO jl=1,jpl 1277 qsr_ice(:,:,jl) = sbc_dcy(qsr_ice(:,:,jl) )1513 zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) ) 1278 1514 ENDDO 1515 ENDIF 1516 1517 IF( ln_mixcpl ) THEN 1518 qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1519 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:) 1520 DO jl=1,jpl 1521 qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:) 1522 ENDDO 1523 ELSE 1524 qsr_tot(:,: ) = zqsr_tot(:,: ) 1525 qsr_ice(:,:,:) = zqsr_ice(:,:,:) 1279 1526 ENDIF 1280 1527 … … 1284 1531 CASE ('coupled') 1285 1532 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 1286 dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)1533 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 1287 1534 ELSE 1288 1535 ! Set all category values equal for the moment 1289 1536 DO jl=1,jpl 1290 dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)1537 zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 1291 1538 ENDDO 1292 1539 ENDIF 1293 1540 END SELECT 1294 1541 1542 IF( ln_mixcpl ) THEN 1543 DO jl=1,jpl 1544 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:) 1545 ENDDO 1546 ELSE 1547 dqns_ice(:,:,:) = zdqns_ice(:,:,:) 1548 ENDIF 1549 1295 1550 ! ! ========================= ! 1296 1551 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt ! … … 1308 1563 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1309 1564 1310 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) 1565 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1566 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1311 1567 ! 1312 1568 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') … … 1344 1600 ! ! ------------------------- ! 1345 1601 IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 1346 SELECT CASE( sn_snd_temp%cldes) 1347 CASE( 'oce only' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 1348 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1349 SELECT CASE( sn_snd_temp%clcat ) 1350 CASE( 'yes' ) 1351 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1352 CASE( 'no' ) 1353 ztmp3(:,:,:) = 0.0 1602 IF ( nn_components == jp_iam_opa ) THEN 1603 ztmp1(:,:) = tsb(:,:,1,jp_tem) 1604 ELSE 1605 SELECT CASE( sn_snd_temp%cldes) 1606 CASE( 'oce only' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 1607 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1608 SELECT CASE( sn_snd_temp%clcat ) 1609 CASE( 'yes' ) 1610 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1611 CASE( 'no' ) 1612 ztmp3(:,:,:) = 0.0 1613 DO jl=1,jpl 1614 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 1615 ENDDO 1616 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1617 END SELECT 1618 CASE( 'mixed oce-ice' ) 1619 ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1354 1620 DO jl=1,jpl 1355 ztmp 3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)1621 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1356 1622 ENDDO 1357 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )1623 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1358 1624 END SELECT 1359 CASE( 'mixed oce-ice' ) 1360 ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1361 DO jl=1,jpl 1362 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1363 ENDDO 1364 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1365 END SELECT 1625 ENDIF 1366 1626 IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1367 1627 IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info ) … … 1386 1646 ! ! ------------------------- ! 1387 1647 ! Send ice fraction field 1388 IF( ssnd(jps_fice)%laction ) THEN1648 IF( ssnd(jps_fice)%laction .OR. ssnd(jps_fice2)%laction ) THEN 1389 1649 SELECT CASE( sn_snd_thick%clcat ) 1390 1650 CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl) … … 1392 1652 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1393 1653 END SELECT 1394 CALL cpl_snd( jps_fice, isec, ztmp3, info ) 1654 IF( ssnd(jps_fice )%laction ) CALL cpl_snd( jps_fice , isec, ztmp3, info ) 1655 IF( ssnd(jps_fice2)%laction ) CALL cpl_snd( jps_fice2, isec, ztmp3, info ) 1395 1656 ENDIF 1396 1657 … … 1440 1701 ! i-1 i i 1441 1702 ! i i+1 (for I) 1442 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1443 CASE( 'oce only' ) ! C-grid ==> T 1444 DO jj = 2, jpjm1 1445 DO ji = fs_2, fs_jpim1 ! vector opt. 1446 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1447 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1448 END DO 1449 END DO 1450 CASE( 'weighted oce and ice' ) 1451 SELECT CASE ( cp_ice_msh ) 1452 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1703 IF( nn_components == jp_iam_opa ) THEN 1704 zotx1(:,:) = ub(:,:,1) 1705 zoty1(:,:) = vb(:,:,1) 1706 ELSE 1707 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1708 CASE( 'oce only' ) ! C-grid ==> T 1453 1709 DO jj = 2, jpjm1 1454 1710 DO ji = fs_2, fs_jpim1 ! vector opt. 1455 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 1456 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 1457 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1458 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1711 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1712 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1459 1713 END DO 1460 1714 END DO 1461 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1462 DO jj = 2, jpjm1 1463 DO ji = 2, jpim1 ! NO vector opt. 1464 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 1465 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1466 zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1467 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1468 zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1469 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1715 CASE( 'weighted oce and ice' ) 1716 SELECT CASE ( cp_ice_msh ) 1717 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1718 DO jj = 2, jpjm1 1719 DO ji = fs_2, fs_jpim1 ! vector opt. 1720 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 1721 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 1722 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1723 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1724 END DO 1470 1725 END DO 1471 END DO1472 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T1473 DO jj = 2, jpjm11474 DO ji = 2, jpim1 ! NO vector opt.1475 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj,1) ) * zfr_l(ji,jj)1476 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj)1477 zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) &1478 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)1479 zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) &1480 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)1726 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1727 DO jj = 2, jpjm1 1728 DO ji = 2, jpim1 ! NO vector opt. 1729 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 1730 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1731 zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1732 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1733 zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1734 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1735 END DO 1481 1736 END DO 1482 END DO 1737 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1738 DO jj = 2, jpjm1 1739 DO ji = 2, jpim1 ! NO vector opt. 1740 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 1741 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1742 zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1743 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1744 zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1745 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1746 END DO 1747 END DO 1748 END SELECT 1749 CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. ) 1750 CASE( 'mixed oce-ice' ) 1751 SELECT CASE ( cp_ice_msh ) 1752 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1753 DO jj = 2, jpjm1 1754 DO ji = fs_2, fs_jpim1 ! vector opt. 1755 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 1756 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1757 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 1758 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1759 END DO 1760 END DO 1761 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1762 DO jj = 2, jpjm1 1763 DO ji = 2, jpim1 ! NO vector opt. 1764 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1765 & + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1766 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1767 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1768 & + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1769 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1770 END DO 1771 END DO 1772 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1773 DO jj = 2, jpjm1 1774 DO ji = 2, jpim1 ! NO vector opt. 1775 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1776 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1777 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1778 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1779 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1780 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1781 END DO 1782 END DO 1783 END SELECT 1483 1784 END SELECT 1484 CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. ) 1485 CASE( 'mixed oce-ice' ) 1486 SELECT CASE ( cp_ice_msh ) 1487 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1488 DO jj = 2, jpjm1 1489 DO ji = fs_2, fs_jpim1 ! vector opt. 1490 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 1491 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1492 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 1493 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1494 END DO 1495 END DO 1496 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1497 DO jj = 2, jpjm1 1498 DO ji = 2, jpim1 ! NO vector opt. 1499 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1500 & + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1501 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1502 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1503 & + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1504 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1505 END DO 1506 END DO 1507 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1508 DO jj = 2, jpjm1 1509 DO ji = 2, jpim1 ! NO vector opt. 1510 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1511 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1512 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1513 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1514 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1515 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1516 END DO 1517 END DO 1518 END SELECT 1519 END SELECT 1520 CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 1785 CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 1786 ! 1787 ENDIF 1521 1788 ! 1522 1789 ! … … 1558 1825 ENDIF 1559 1826 ! 1827 ! 1828 ! Fields sent to ice by ocean model when OASIS coupling 1829 ! ! SSH 1830 IF( ssnd(jps_ssh )%laction ) THEN 1831 ! ! removed inverse barometer ssh when Patm 1832 ! forcing is used (for sea-ice dynamics) 1833 IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 1834 ELSE ; ztmp1(:,:) = sshb(:,:) 1835 ENDIF 1836 CALL cpl_snd( jps_ssh, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1837 1838 ENDIF 1839 ! ! SSS 1840 IF( ssnd(jps_soce)%laction ) THEN 1841 ztmp1(:,:) = tsb(:,:,1,jp_sal) 1842 CALL cpl_snd( jps_soce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1843 ENDIF 1844 ! 1845 ! Fields sent to ocean by ice model when OASIS coupling 1846 ! ! Solar heat flux 1847 IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info ) 1848 IF( ssnd(jps_qnsoce)%laction ) CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info ) 1849 IF( ssnd(jps_oemp )%laction ) CALL cpl_snd( jps_oemp , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info ) 1850 IF( ssnd(jps_sflx )%laction ) CALL cpl_snd( jps_sflx , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info ) 1851 IF( ssnd(jps_otx1 )%laction ) CALL cpl_snd( jps_otx1 , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info ) 1852 IF( ssnd(jps_oty1 )%laction ) CALL cpl_snd( jps_oty1 , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info ) 1853 IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) 1854 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 1855 1560 1856 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 1561 1857 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
r4990 r5220 105 105 fr_i(:,:) = eos_fzp( sss_m ) * tmask(:,:,1) ! sea surface freezing temperature [Celcius] 106 106 107 IF( l k_cpl ) a_i(:,:,1) = fr_i(:,:)107 IF( ln_cpl ) a_i(:,:,1) = fr_i(:,:) 108 108 109 109 ! Flux and ice fraction computation -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r5167 r5220 110 110 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 111 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice ! mean ice albedo (for coupled) 112 REAL(wp), POINTER, DIMENSION(:,: ) :: zutau_ice, zvtau_ice 112 113 !!---------------------------------------------------------------------- 113 114 … … 125 126 ! 126 127 ! Ice albedo 128 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) 127 129 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 128 130 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos … … 179 181 END SELECT 180 182 181 !------------------------------! 182 ! --- LIM-3 main time-step --- ! 183 !------------------------------! 183 IF( ln_mixcpl) THEN 184 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 185 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 186 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 187 ENDIF 188 189 ! !----------------------! 190 ! ! LIM-3 time-stepping ! 191 ! !----------------------! 192 ! 184 193 numit = numit + nn_fsbc ! Ice model time step 185 194 ! … … 247 256 IF( ln_icectl ) CALL lim_ctl( kt ) ! alerts in case of model crash 248 257 ! 258 CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice) 249 259 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 250 260 ! -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r4990 r5220 101 101 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice ! mean ice albedo 102 102 REAL(wp), DIMENSION(:,:,:), POINTER :: zsist ! ice surface temperature (K) 103 REAL(wp), DIMENSION(:,: ), POINTER :: zutau_ice, zvtau_ice 103 104 !!---------------------------------------------------------------------- 104 105 CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )106 105 107 106 IF( kt == nit000 ) THEN … … 124 123 &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1 125 124 # endif 125 126 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) 127 CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 128 126 129 ! Bulk Formulea ! 127 130 !----------------! … … 132 135 DO ji = 2, jpi ! NO vector opt. possible 133 136 u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj ) * umask(ji-1,jj ,1) & 134 & + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj)137 & + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj) 135 138 v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji ,jj-1) * vmask(ji ,jj-1,1) & 136 & + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj)139 & + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj) 137 140 END DO 138 141 END DO … … 199 202 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 200 203 END SELECT 204 205 IF( ln_mixcpl) THEN 206 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 207 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 208 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 209 ENDIF 201 210 202 211 CALL iom_put( 'utau_ice', utau_ice ) ! Wind stress over ice along i-axis at I-point … … 228 237 END IF 229 238 ! ! Ice surface fluxes in coupled mode 230 IF( ksbc == jp_cpl ) THEN239 IF( ln_cpl ) THEN ! pure coupled and mixed forced-coupled configurations 231 240 a_i(:,:,1)=fr_i 232 241 CALL sbc_cpl_ice_flx( frld, & … … 253 262 IF( .NOT. Agrif_Root() ) CALL agrif_update_lim2( kt ) 254 263 # endif 264 ! 265 CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice) 266 CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 255 267 ! 256 268 ENDIF ! End sea-ice time step only … … 264 276 IF( ln_limdyn ) CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 265 277 ! 266 CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )267 !268 278 END SUBROUTINE sbc_ice_lim_2 269 279 -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r5123 r5220 38 38 USE sbcice_cice ! surface boundary condition: CICE sea-ice model 39 39 USE sbccpl ! surface boundary condition: coupled florulation 40 USE cpl_oasis3 ! OASIS routines for coupling 40 41 USE sbcssr ! surface boundary condition: sea surface restoring 41 42 USE sbcrnf ! surface boundary condition: runoffs … … 83 84 INTEGER :: icpt ! local integer 84 85 !! 85 NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx, ln_blk_clio, ln_blk_core, & 86 & ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc , ln_rnf, & 87 & ln_ssr , nn_isf , nn_fwb , ln_cdgw , ln_wave , ln_sdw, nn_lsm, nn_limflx 86 NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx, ln_blk_clio, ln_blk_core, ln_mixcpl, & 87 & ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc , ln_rnf , & 88 & ln_ssr , nn_isf , nn_fwb, ln_cdgw , ln_wave , ln_sdw , & 89 & nn_lsm , nn_limflx , nn_components, ln_cpl 88 90 INTEGER :: ios 91 INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3, jpm 92 LOGICAL :: ll_purecpl 89 93 !!---------------------------------------------------------------------- 90 94 … … 114 118 nn_ice = 0 115 119 ENDIF 116 120 117 121 IF(lwp) THEN ! Control print 118 122 WRITE(numout,*) ' Namelist namsbc (partly overwritten with CPP key setting)' … … 124 128 WRITE(numout,*) ' CORE bulk formulation ln_blk_core = ', ln_blk_core 125 129 WRITE(numout,*) ' MFS bulk formulation ln_blk_mfs = ', ln_blk_mfs 126 WRITE(numout,*) ' coupled formulation (T if key_oasis3) lk_cpl = ', lk_cpl 130 WRITE(numout,*) ' forced-coupled mixed formulation ln_mixcpl = ', ln_mixcpl 131 WRITE(numout,*) ' coupled formulation ln_cpl = ', ln_cpl 132 WRITE(numout,*) ' OASIS coupling (with atm or sas) lk_oasis = ', lk_oasis 133 WRITE(numout,*) ' components of your executable nn_components = ', nn_components 127 134 WRITE(numout,*) ' Multicategory heat flux formulation (LIM3) nn_limflx = ', nn_limflx 128 135 WRITE(numout,*) ' Misc. options of sbc : ' … … 163 170 #endif 164 171 172 IF ( nn_components /= jp_iam_nemo .AND. .NOT. lk_oasis ) & 173 & CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' ) 174 IF ( ln_cpl .AND. .NOT. lk_oasis ) & 175 & CALL ctl_stop( 'STOP', 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' ) 176 IF( ln_mixcpl .AND. .NOT. lk_oasis ) & 177 & CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires the cpp key key_oasis3' ) 178 IF( ln_mixcpl .AND. nn_components /= jp_iam_nemo ) & 179 & CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) is not yet working with sas-opa coupling via oasis' ) 180 165 181 ! 166 182 ! ! allocate sbc arrays … … 182 198 fwfisf_b(:,:) = 0.0_wp 183 199 END IF 184 IF( nn_ice == 0 ) fr_i(:,:) = 0.e0! no ice in the domain, ice fraction is always zero200 IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa ) fr_i(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero 185 201 186 202 sfx(:,:) = 0.0_wp ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero) … … 192 208 193 209 ! ! restartability 194 IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR. & 195 MOD( nstock , nn_fsbc) /= 0 ) THEN 196 WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock, & 197 & ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')' 198 CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' ) 199 ENDIF 200 ! 201 IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 ) & 202 & CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 203 ! 204 IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) ) & 210 IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) ) & 205 211 & CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' ) 206 IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. l k_cpl ) ) &207 & CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or l k_cpl' )212 IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. ln_cpl ) ) & 213 & CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or ln_cpl' ) 208 214 IF( nn_ice == 4 .AND. lk_agrif ) & 209 215 & CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' ) … … 212 218 IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) ) & 213 219 & WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3' 214 IF( ( nn_ice == 3 ) .AND. ( l k_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) ) &220 IF( ( nn_ice == 3 ) .AND. ( ln_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) ) & 215 221 & CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 216 IF( ( nn_ice == 3 ) .AND. ( .NOT. l k_cpl ) .AND. ( nn_limflx == 2 ) ) &222 IF( ( nn_ice == 3 ) .AND. ( .NOT. ln_cpl ) .AND. ( nn_limflx == 2 ) ) & 217 223 & CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' ) 218 224 … … 222 228 & CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' ) 223 229 224 IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) ) < 8 ) ) &225 & CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )226 227 230 IF ( ln_wave ) THEN 228 231 !Activated wave module but neither drag nor stokes drift activated … … 240 243 241 244 ! ! Choice of the Surface Boudary Condition (set nsbc) 245 ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl 246 ! 242 247 icpt = 0 243 248 IF( ln_ana ) THEN ; nsbc = jp_ana ; icpt = icpt + 1 ; ENDIF ! analytical formulation … … 246 251 IF( ln_blk_core ) THEN ; nsbc = jp_core ; icpt = icpt + 1 ; ENDIF ! CORE bulk formulation 247 252 IF( ln_blk_mfs ) THEN ; nsbc = jp_mfs ; icpt = icpt + 1 ; ENDIF ! MFS bulk formulation 248 IF( l k_cpl ) THEN ; nsbc = jp_cpl ; icpt = icpt + 1 ; ENDIF ! Coupledformulation253 IF( ll_purecpl ) THEN ; nsbc = jp_cpl ; icpt = icpt + 1 ; ENDIF ! Pure Coupled formulation 249 254 IF( cp_cfg == 'gyre') THEN ; nsbc = jp_gyre ; ENDIF ! GYRE analytical formulation 255 IF( nn_components == jp_iam_opa ) THEN ; nsbc = jp_none ; icpt = icpt + 1 ; ENDIF ! opa coupling via SAS module 250 256 IF( lk_esopa ) nsbc = jp_esopa ! esopa test, ALL formulations 251 257 ! … … 265 271 IF( nsbc == jp_clio ) WRITE(numout,*) ' CLIO bulk formulation' 266 272 IF( nsbc == jp_core ) WRITE(numout,*) ' CORE bulk formulation' 267 IF( nsbc == jp_cpl ) WRITE(numout,*) ' coupled formulation'273 IF( nsbc == jp_cpl ) WRITE(numout,*) ' pure coupled formulation' 268 274 IF( nsbc == jp_mfs ) WRITE(numout,*) ' MFS Bulk formulation' 269 ENDIF 270 ! 275 IF( nsbc == jp_none ) WRITE(numout,*) ' OPA coupled to SAS via oasis' 276 IF( ln_mixcpl ) WRITE(numout,*) ' + forced-coupled mixed formulation' 277 IF( nn_components/= 0 ) WRITE(numout,*) ' + OASIS coupled SAS' 278 ENDIF 279 ! 280 IF( lk_oasis ) CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before: (1) first time step 281 ! ! (2) the use of nn_fsbc 282 283 ! nn_fsbc initialization if OPA-SAS coupling via OASIS 284 ! sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 285 IF ( nn_components /= jp_iam_nemo ) THEN 286 287 IF ( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt) 288 IF ( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt) 289 ! 290 IF(lwp)THEN 291 WRITE(numout,*) 292 WRITE(numout,*)" OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc 293 WRITE(numout,*) 294 ENDIF 295 ENDIF 296 297 IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR. & 298 MOD( nstock , nn_fsbc) /= 0 ) THEN 299 WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock, & 300 & ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')' 301 CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' ) 302 ENDIF 303 ! 304 IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 ) & 305 & CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 306 ! 307 IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) ) < 8 ) ) & 308 & CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 309 310 311 IF( nn_components /= jp_iam_sas ) THEN 312 271 313 CALL sbc_ssm_init ! Sea-surface mean fields initialisation 314 ELSE 315 ! 316 ! sas currently uses surface temperature and salinity in tsn array 317 ! for initialisation 318 ! and ub, vb arrays in ice dynamics 319 ! so allocate enough of arrays to use 320 ! 321 ierr3 = 0 322 jpm = MAX(jp_tem, jp_sal) 323 ALLOCATE( tsn(jpi,jpj,1,jpm), STAT=ierr0 ) 324 ALLOCATE( ub(jpi,jpj,1) , STAT=ierr1 ) 325 ALLOCATE( vb(jpi,jpj,1) , STAT=ierr2 ) 326 IF ( nn_ice == 1 ) ALLOCATE( tsb(jpi,jpj,1,jpm), STAT=ierr3 ) 327 ierr = ierr0 + ierr1 + ierr2 + ierr3 328 IF( ierr > 0 ) THEN 329 CALL ctl_stop('sbc_ssm_init: unable to allocate surface arrays') 330 ENDIF 331 332 ENDIF 272 333 ! 273 334 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialisation … … 276 337 277 338 IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialisation 278 ! 279 IF( nsbc == jp_cpl ) CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before first time step 280 339 281 340 END SUBROUTINE sbc_init 282 341 … … 321 380 ! (caution called before sbc_ssm) 322 381 ! 323 CALL sbc_ssm( kt )! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)382 IF( nn_components /= jp_iam_sas ) CALL sbc_ssm( kt ) ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 324 383 ! ! averaged over nf_sbc time-step 325 384 … … 333 392 CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation 334 393 CASE( jp_clio ) ; CALL sbc_blk_clio( kt ) ! bulk formulation : CLIO for the ocean 335 CASE( jp_core ) ; CALL sbc_blk_core( kt ) ! bulk formulation : CORE for the ocean 336 CASE( jp_cpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! coupled formulation 394 CASE( jp_core ) 395 IF( nn_components == jp_iam_sas ) & 396 CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OASIS-coupled ice 397 CALL sbc_blk_core( kt ) ! bulk formulation : CORE for the ocean 398 ! from oce: sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 399 CASE( jp_cpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! pure coupled formulation 400 ! 337 401 CASE( jp_mfs ) ; CALL sbc_blk_mfs ( kt ) ! bulk formulation : MFS for the ocean 402 CASE( jp_none ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OASIS-coupled ice 403 ! fluxes qsr, qns, emp, sfx,utau, vtau 404 ! sss_m, ssu_m, ssv_m) 338 405 CASE( jp_esopa ) 339 406 CALL sbc_ana ( kt ) ! ESOPA, test ALL the formulations … … 344 411 CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! 345 412 END SELECT 413 414 IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! forced-coupled mixed formulation 415 346 416 347 417 ! !== Misc. Options ==! … … 408 478 ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b' , qsr ) 409 479 CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp ) 410 CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx)480 CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx ) 411 481 ENDIF 412 482 … … 423 493 CALL iom_put( "qns" , qns ) ! solar heat flux 424 494 CALL iom_put( "qsr" , qsr ) ! solar heat flux 425 IF( nn_ice > 0 ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction495 IF( nn_ice > 0 .OR. nn_components == jp_iam_opa ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction 426 496 CALL iom_put( "taum" , taum ) ! wind stress module 427 497 CALL iom_put( "wspd" , wndm ) ! wind speed module over free ocean or leads in presence of sea-ice -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r5120 r5220 64 64 DO jj = 1, jpj 65 65 DO ji = 1, jpi 66 zts(ji,jj,jp_tem) = ts n(ji,jj,mikt(ji,jj),jp_tem)67 zts(ji,jj,jp_sal) = ts n(ji,jj,mikt(ji,jj),jp_sal)66 zts(ji,jj,jp_tem) = tsb(ji,jj,mikt(ji,jj),jp_tem) 67 zts(ji,jj,jp_sal) = tsb(ji,jj,mikt(ji,jj),jp_sal) 68 68 END DO 69 69 END DO … … 84 84 sss_m(:,:) = zts(:,:,jp_sal) 85 85 ! ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 86 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = ssh n(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )87 ELSE ; ssh_m(:,:) = ssh n(:,:)86 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 87 ELSE ; ssh_m(:,:) = sshb(:,:) 88 88 ENDIF 89 89 ! … … 104 104 sss_m(:,:) = zcoef * zts(:,:,jp_sal) 105 105 ! ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 106 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = zcoef * ( ssh n(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) )107 ELSE ; ssh_m(:,:) = zcoef * ssh n(:,:)106 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = zcoef * ( sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 107 ELSE ; ssh_m(:,:) = zcoef * sshb(:,:) 108 108 ENDIF 109 109 ! … … 129 129 sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal) 130 130 ! ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 131 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = ssh_m(:,:) + ssh n(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )132 ELSE ; ssh_m(:,:) = ssh_m(:,:) + ssh n(:,:)131 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = ssh_m(:,:) + sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 132 ELSE ; ssh_m(:,:) = ssh_m(:,:) + sshb(:,:) 133 133 ENDIF 134 134 ! -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r5120 r5220 761 761 IF( nn_pdl < 0 .OR. nn_pdl > 1 ) CALL ctl_stop( 'bad flag: nn_pdl is 0 or 1 ' ) 762 762 IF( nn_htau < 0 .OR. nn_htau > 1 ) CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' ) 763 IF( nn_etau == 3 .AND. .NOT. l k_cpl ) CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' )763 IF( nn_etau == 3 .AND. .NOT. ln_cpl ) CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' ) 764 764 765 765 IF( ln_mxl0 ) THEN -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r5123 r5220 82 82 USE crsini ! initialise grid coarsening utility 83 83 USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 84 USE sbc_oce, ONLY: lk_oasis 84 85 85 86 IMPLICIT NONE … … 195 196 #if defined key_iomput 196 197 CALL xios_finalize ! end mpp communications with xios 197 IF( lk_ cpl) CALL cpl_finalize ! end coupling and mpp communications with OASIS198 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 198 199 #else 199 IF( lk_ cpl) THEN200 IF( lk_oasis ) THEN 200 201 CALL cpl_finalize ! end coupling and mpp communications with OASIS 201 202 ELSE … … 226 227 ! 227 228 cltxt = '' 229 cxios_context = 'nemo' 228 230 ! 229 231 ! ! Open reference namelist and configuration namelist files … … 272 274 #if defined key_iomput 273 275 IF( Agrif_Root() ) THEN 274 IF( lk_ cpl) THEN275 CALL cpl_init( ilocal_comm )! nemo local communicator given by oasis276 CALL xios_initialize( " oceanx",local_comm=ilocal_comm ) ! send nemo communicator to xios276 IF( lk_oasis ) THEN 277 CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis 278 CALL xios_initialize( "not used",local_comm=ilocal_comm ) ! send nemo communicator to xios 277 279 ELSE 278 CALL xios_initialize( " nemo",return_comm=ilocal_comm ) ! nemo local communicator given by xios280 CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios 279 281 ENDIF 280 282 ENDIF 281 283 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 282 284 #else 283 IF( lk_ cpl) THEN285 IF( lk_oasis ) THEN 284 286 IF( Agrif_Root() ) THEN 285 CALL cpl_init( ilocal_comm )! nemo local communicator given by oasis287 CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis 286 288 ENDIF 287 289 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/step.F90
r5147 r5220 83 83 IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 84 84 # if defined key_iomput 85 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( "nemo")85 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( cxios_context ) 86 86 # endif 87 87 #endif 88 88 indic = 0 ! reset to no error condition 89 89 IF( kstp == nit000 ) THEN 90 CALL iom_init( "nemo" ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 91 IF( ln_crs ) CALL iom_init( "nemo_crs" ) ! initialize context for coarse grid 90 ! must be done after nemo_init for AGRIF+XIOS+OASIS 91 CALL iom_init( cxios_context ) ! iom_put initialization 92 IF( ln_crs ) CALL iom_init( TRIM(cxios_context)//"_crs" ) ! initialize context for coarse grid 92 93 ENDIF 93 94 94 95 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) 95 CALL iom_setkt( kstp - nit000 + 1, "nemo" ) ! say to iom thatwe are at time step kstp96 IF( ln_crs ) CALL iom_setkt( kstp - nit000 + 1, "nemo_crs" ) ! say to iom thatwe are at time step kstp96 CALL iom_setkt( kstp - nit000 + 1, cxios_context ) ! tell iom we are at time step kstp 97 IF( ln_crs ) CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" ) ! tell iom we are at time step kstp 97 98 98 99 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 218 219 IF( lk_floats ) CALL flo_stp( kstp ) ! drifting Floats 219 220 IF( lk_diahth ) CALL dia_hth( kstp ) ! Thermocline depth (20 degres isotherm depth) 220 IF( .NOT. l k_cpl ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics221 IF( .NOT. ln_cpl ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics 221 222 IF( lk_diadct ) CALL dia_dct( kstp ) ! Transports 222 223 IF( lk_diaar5 ) CALL dia_ar5( kstp ) ! ar5 diag … … 346 347 ! Coupled mode 347 348 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 348 IF( lk_ cpl) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges349 IF( lk_oasis ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges 349 350 ! 350 351 #if defined key_iomput 351 352 IF( kstp == nitend .OR. indic < 0 ) THEN 352 CALL iom_context_finalize( "nemo") ! needed for XIOS+AGRIF353 IF( ln_crs ) CALL iom_context_finalize( "nemo_crs" ) !353 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 354 IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) ! 354 355 ENDIF 355 356 #endif -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r5215 r5220 53 53 USE xios 54 54 #endif 55 USE cpl_oasis3 55 56 USE sbcssm 56 57 USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges … … 138 139 #if defined key_iomput 139 140 CALL xios_finalize ! end mpp communications with xios 141 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 140 142 #else 141 IF( lk_mpp ) CALL mppstop ! end mpp communications 143 IF( lk_oasis ) THEN 144 CALL cpl_finalize ! end coupling and mpp communications with OASIS 145 ELSE 146 IF( lk_mpp ) CALL mppstop ! end mpp communications 147 ENDIF 142 148 #endif 143 149 ! … … 164 170 !!---------------------------------------------------------------------- 165 171 cltxt = '' 172 cxios_context = 'sas' 166 173 ! 167 174 ! ! Open reference namelist and configuration namelist files 168 CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 169 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 175 IF( lk_oasis ) THEN 176 CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 177 CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 178 ELSE 179 CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 180 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 181 ENDIF 170 182 ! 171 183 REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints & Benchmark … … 193 205 #if defined key_iomput 194 206 IF( Agrif_Root() ) THEN 195 CALL xios_initialize( "nemo",return_comm=ilocal_comm ) 207 IF( lk_oasis ) THEN 208 CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis 209 CALL xios_initialize( "not used",local_comm=ilocal_comm ) ! send nemo communicator to xios 210 ELSE 211 CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios 212 ENDIF 196 213 ENDIF 197 214 narea = mynode ( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 198 215 #else 199 ilocal_comm = 0 200 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 216 IF( lk_oasis ) THEN 217 IF( Agrif_Root() ) THEN 218 CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis 219 ENDIF 220 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 221 ELSE 222 ilocal_comm = 0 223 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt) 224 ENDIF 201 225 #endif 202 226 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) … … 244 268 IF(lwp) THEN ! open listing units 245 269 ! 246 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 270 IF( lk_oasis ) THEN 271 CALL ctl_opn( numout, 'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 272 ELSE 273 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 274 ENDIF 247 275 ! 248 276 WRITE(numout,*) … … 287 315 288 316 IF( ln_ctl ) CALL prt_ctl_init ! Print control 289 CALL flush(numout)290 291 317 CALL day_init ! model calendar (using both namelist and restart infos) 292 318 -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/SAS_SRC/step.F90
r5215 r5220 72 72 kstp = nit000 + Agrif_Nb_Step() 73 73 # if defined key_iomput 74 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( "nemo")74 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( cxios_context ) 75 75 # endif 76 76 #endif 77 IF( kstp == nit000 ) CALL iom_init( "nemo" )! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)77 IF( kstp == nit000 ) CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 78 78 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) 79 CALL iom_setkt( kstp , "nemo" ) ! say to iom thatwe are at time step kstp79 CALL iom_setkt( kstp - nit000 + 1, cxios_context ) ! tell iom we are at time step kstp 80 80 81 81 CALL sbc ( kstp ) ! Sea Boundary Condition (including sea-ice) … … 87 87 CALL stp_ctl( kstp, indic ) 88 88 #if defined key_iomput 89 IF( kstp == nitend ) CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF 89 IF( kstp == nitend .OR. indic < 0 ) THEN 90 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 91 ENDIF 90 92 #endif 91 93 ! -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/fcm-make/inc/keys-amm12.cfg
r5218 r5220 1 1 preprocess.prop{fpp.defs} = \ 2 key_bdy key_tide key_ dynspg_ts key_ldfslp key_zdfgls key_vvl key_diainstant key_mpp_mpi key_iomput2 key_bdy key_tide key_vectopt_loop key_amm_12km key_dynspg_ts key_ldfslp key_zdfgls key_vvl key_diainstant key_mpp_mpi key_iomput -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/fcm-make/inc/keys-gyre.cfg
r5218 r5220 1 1 preprocess.prop{fpp.defs} = \ 2 key_ dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi key_nosignedzero2 key_gyre key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/fcm-make/inc/keys-gyre_pisces.cfg
r5218 r5220 1 1 preprocess.prop{fpp.defs} = \ 2 key_ dynspg_flt key_ldfslp key_zdftke key_top key_pisces_reduced key_iomput key_mpp_mpi2 key_gyre key_dynspg_flt key_ldfslp key_zdftke key_top key_pisces_reduced key_iomput key_mpp_mpi -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/fcm-make/inc/keys-orca2_lim.cfg
r5218 r5220 1 1 preprocess.prop{fpp.defs} = \ 2 key_trabbl key_ lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_diaobs key_asminc2 key_trabbl key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/fcm-make/inc/keys-orca2_lim_cfc.cfg
r5218 r5220 1 1 preprocess.prop{fpp.defs} = \ 2 key_trabbl key_ lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_cfc key_c14b key_iomput key_mpp_mpi2 key_trabbl key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_cfc key_c14b key_iomput key_mpp_mpi -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/fcm-make/inc/keys-orca2_lim_pisces.cfg
r5218 r5220 1 1 preprocess.prop{fpp.defs} = \ 2 key_trabbl key_ lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_pisces key_iomput key_mpp_mpi2 key_trabbl key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_pisces key_iomput key_mpp_mpi -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/fcm-make/inc/keys-orca2_off_pisces.cfg
r5218 r5220 1 1 preprocess.prop{fpp.defs} = \ 2 key_trabbl key_ ldfslp key_traldf_c2d key_traldf_eiv key_top key_offline key_pisces key_iomput key_mpp_mpi2 key_trabbl key_orca_r2 key_ldfslp key_traldf_c2d key_traldf_eiv key_top key_offline key_pisces key_iomput key_mpp_mpi
Note: See TracChangeset
for help on using the changeset viewer.