Changeset 14072 for NEMO/trunk/src/OCE/SBC/sbccpl.F90
- Timestamp:
- 2020-12-04T08:48:38+01:00 (3 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/OCE/SBC/sbccpl.F90 (modified) (126 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/SBC/sbccpl.F90
r14007 r14072 33 33 #endif 34 34 USE cpl_oasis3 ! OASIS3 coupling 35 USE geo2ocean ! 35 USE geo2ocean ! 36 36 USE oce , ONLY : ts, uu, vv, ssh, fraqsr_1lev 37 USE ocealb ! 38 USE eosbn2 ! 37 USE ocealb ! 38 USE eosbn2 ! 39 39 USE sbcrnf , ONLY : l_rnfcpl 40 40 #if defined key_cice … … 50 50 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 51 51 52 #if defined key_oasis3 53 USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut 54 #endif 52 #if defined key_oasis3 53 USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut 54 #endif 55 56 USE sbc_phy, ONLY : pp_cldf 55 57 56 58 IMPLICIT NONE … … 65 67 66 68 INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 1 67 INTEGER, PARAMETER :: jpr_oty1 = 2 ! 68 INTEGER, PARAMETER :: jpr_otz1 = 3 ! 69 INTEGER, PARAMETER :: jpr_oty1 = 2 ! 70 INTEGER, PARAMETER :: jpr_otz1 = 3 ! 69 71 INTEGER, PARAMETER :: jpr_otx2 = 4 ! 3 atmosphere-ocean stress components on grid 2 70 INTEGER, PARAMETER :: jpr_oty2 = 5 ! 71 INTEGER, PARAMETER :: jpr_otz2 = 6 ! 72 INTEGER, PARAMETER :: jpr_oty2 = 5 ! 73 INTEGER, PARAMETER :: jpr_otz2 = 6 ! 72 74 INTEGER, PARAMETER :: jpr_itx1 = 7 ! 3 atmosphere-ice stress components on grid 1 73 INTEGER, PARAMETER :: jpr_ity1 = 8 ! 74 INTEGER, PARAMETER :: jpr_itz1 = 9 ! 75 INTEGER, PARAMETER :: jpr_ity1 = 8 ! 76 INTEGER, PARAMETER :: jpr_itz1 = 9 ! 75 77 INTEGER, PARAMETER :: jpr_itx2 = 10 ! 3 atmosphere-ice stress components on grid 2 76 INTEGER, PARAMETER :: jpr_ity2 = 11 ! 77 INTEGER, PARAMETER :: jpr_itz2 = 12 ! 78 INTEGER, PARAMETER :: jpr_ity2 = 11 ! 79 INTEGER, PARAMETER :: jpr_itz2 = 12 ! 78 80 INTEGER, PARAMETER :: jpr_qsroce = 13 ! Qsr above the ocean 79 81 INTEGER, PARAMETER :: jpr_qsrice = 14 ! Qsr above the ice 80 INTEGER, PARAMETER :: jpr_qsrmix = 15 82 INTEGER, PARAMETER :: jpr_qsrmix = 15 81 83 INTEGER, PARAMETER :: jpr_qnsoce = 16 ! Qns above the ocean 82 84 INTEGER, PARAMETER :: jpr_qnsice = 17 ! Qns above the ice … … 103 105 INTEGER, PARAMETER :: jpr_ocy1 = 38 ! 104 106 INTEGER, PARAMETER :: jpr_ssh = 39 ! sea surface height 105 INTEGER, PARAMETER :: jpr_fice = 40 ! ice fraction 106 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 107 INTEGER, PARAMETER :: jpr_fice = 40 ! ice fraction 108 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 107 109 INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level 108 INTEGER, PARAMETER :: jpr_mslp = 43 ! mean sea level pressure 110 INTEGER, PARAMETER :: jpr_mslp = 43 ! mean sea level pressure 109 111 !** surface wave coupling ** 110 112 INTEGER, PARAMETER :: jpr_hsig = 44 ! Hsig … … 128 130 INTEGER, PARAMETER :: jpr_ts_ice = 62 ! Sea ice surface temp 129 131 130 INTEGER, PARAMETER :: jprcv = 62 ! total number of fields received 132 INTEGER, PARAMETER :: jprcv = 62 ! total number of fields received 131 133 132 134 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 152 154 INTEGER, PARAMETER :: jps_sflx = 21 ! salt flux 153 155 INTEGER, PARAMETER :: jps_otx1 = 22 ! 2 atmosphere-ocean stress components on grid 1 154 INTEGER, PARAMETER :: jps_oty1 = 23 ! 156 INTEGER, PARAMETER :: jps_oty1 = 23 ! 155 157 INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs 156 158 INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module … … 158 160 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 159 161 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level 160 INTEGER, PARAMETER :: jps_ficet = 29 ! total ice fraction 161 INTEGER, PARAMETER :: jps_ocxw = 30 ! currents on grid 1 162 INTEGER, PARAMETER :: jps_ficet = 29 ! total ice fraction 163 INTEGER, PARAMETER :: jps_ocxw = 30 ! currents on grid 1 162 164 INTEGER, PARAMETER :: jps_ocyw = 31 ! currents on grid 2 163 INTEGER, PARAMETER :: jps_wlev = 32 ! water level 165 INTEGER, PARAMETER :: jps_wlev = 32 ! water level 164 166 INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes) 165 167 INTEGER, PARAMETER :: jps_a_p = 34 ! meltpond area fraction … … 169 171 INTEGER, PARAMETER :: jps_ttilyr = 38 ! sea ice top layer temp 170 172 171 INTEGER, PARAMETER :: jpsnd = 38 ! total number of fields sent 172 173 #if ! defined key_oasis3 174 ! Dummy variables to enable compilation when oasis3 is not being used 175 INTEGER :: OASIS_Sent = -1 176 INTEGER :: OASIS_SentOut = -1 177 INTEGER :: OASIS_ToRest = -1 178 INTEGER :: OASIS_ToRestOut = -1 179 #endif 173 INTEGER, PARAMETER :: jpsnd = 38 ! total number of fields sent 174 175 #if ! defined key_oasis3 176 ! Dummy variables to enable compilation when oasis3 is not being used 177 INTEGER :: OASIS_Sent = -1 178 INTEGER :: OASIS_SentOut = -1 179 INTEGER :: OASIS_ToRest = -1 180 INTEGER :: OASIS_ToRestOut = -1 181 #endif 180 182 181 183 ! !!** namelist namsbc_cpl ** 182 TYPE :: FLD_C ! 184 TYPE :: FLD_C ! 183 185 CHARACTER(len = 32) :: cldes ! desciption of the coupling strategy 184 186 CHARACTER(len = 32) :: clcat ! multiple ice categories strategy … … 187 189 CHARACTER(len = 32) :: clvgrd ! grids on which is located the vector fields 188 190 END TYPE FLD_C 189 ! ! Send to the atmosphere 191 ! ! Send to the atmosphere 190 192 TYPE(FLD_C) :: sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 191 193 & sn_snd_thick1, sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_ttilyr … … 194 196 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf, sn_rcv_ts_ice 195 197 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf 196 ! ! Send to waves 197 TYPE(FLD_C) :: sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev 198 ! ! Received from waves 198 ! ! Send to waves 199 TYPE(FLD_C) :: sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev 200 ! ! Received from waves 199 201 TYPE(FLD_C) :: sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, & 200 202 & sn_rcv_wstrf, sn_rcv_wdrag, sn_rcv_charn, sn_rcv_taw, sn_rcv_bhd, sn_rcv_tusd, sn_rcv_tvsd … … 203 205 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 204 206 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 205 LOGICAL :: ln_scale_ice_flux ! use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 206 207 TYPE :: DYNARR 208 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 207 LOGICAL :: ln_scale_ice_flux ! use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 208 209 TYPE :: DYNARR 210 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 209 211 END TYPE DYNARR 210 212 … … 216 218 #endif 217 219 218 REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2] 219 REAL(wp) :: r1_grau ! = 1.e0 / (grav * rho0) 220 REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2] 221 REAL(wp) :: r1_grau ! = 1.e0 / (grav * rho0) 220 222 221 223 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) :: nrcvinfo ! OASIS info argument … … 230 232 !!---------------------------------------------------------------------- 231 233 CONTAINS 232 234 233 235 INTEGER FUNCTION sbc_cpl_alloc() 234 236 !!---------------------------------------------------------------------- … … 240 242 ! 241 243 ALLOCATE( alb_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) ) 242 244 243 245 #if ! defined key_si3 && ! defined key_cice 244 246 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) … … 258 260 259 261 260 SUBROUTINE sbc_cpl_init( k_ice ) 262 SUBROUTINE sbc_cpl_init( k_ice ) 261 263 !!---------------------------------------------------------------------- 262 264 !! *** ROUTINE sbc_cpl_init *** … … 265 267 !! the atmospheric component 266 268 !! 267 !! ** Method : * Read namsbc_cpl namelist 269 !! ** Method : * Read namsbc_cpl namelist 268 270 !! * define the receive interface 269 271 !! * define the send interface … … 277 279 !! 278 280 NAMELIST/namsbc_cpl/ nn_cplmodel , ln_usecplmask, nn_cats_cpl , ln_scale_ice_flux, & 279 & sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2 , & 280 & sn_snd_ttilyr, sn_snd_cond , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1, & 281 & sn_snd_ifrac , sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc , & 282 & sn_rcv_w10m , sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr , & 281 & sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2 , & 282 & sn_snd_ttilyr, sn_snd_cond , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1, & 283 & sn_snd_ifrac , sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc , & 284 & sn_rcv_w10m , sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr , & 283 285 & sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum , sn_rcv_wstrf , & 284 286 & sn_rcv_charn , sn_rcv_taw , sn_rcv_bhd , sn_rcv_tusd , sn_rcv_tvsd, & 285 287 & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , & 286 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_icb , sn_rcv_isf , sn_rcv_ts_ice 288 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_icb , sn_rcv_isf , sn_rcv_ts_ice 287 289 288 290 !!--------------------------------------------------------------------- … … 328 330 WRITE(numout,*)' Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')' 329 331 WRITE(numout,*)' surface waves:' 330 WRITE(numout,*)' significant wave heigth = ', TRIM(sn_rcv_hsig%cldes ), ' (', TRIM(sn_rcv_hsig%clcat ), ')' 331 WRITE(numout,*)' wave to oce energy flux = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')' 332 WRITE(numout,*)' Surface Stokes drift grid u = ', TRIM(sn_rcv_sdrfx%cldes ), ' (', TRIM(sn_rcv_sdrfx%clcat ), ')' 333 WRITE(numout,*)' Surface Stokes drift grid v = ', TRIM(sn_rcv_sdrfy%cldes ), ' (', TRIM(sn_rcv_sdrfy%clcat ), ')' 334 WRITE(numout,*)' Mean wave period = ', TRIM(sn_rcv_wper%cldes ), ' (', TRIM(sn_rcv_wper%clcat ), ')' 335 WRITE(numout,*)' Mean wave number = ', TRIM(sn_rcv_wnum%cldes ), ' (', TRIM(sn_rcv_wnum%clcat ), ')' 332 WRITE(numout,*)' significant wave heigth = ', TRIM(sn_rcv_hsig%cldes ), ' (', TRIM(sn_rcv_hsig%clcat ), ')' 333 WRITE(numout,*)' wave to oce energy flux = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')' 334 WRITE(numout,*)' Surface Stokes drift grid u = ', TRIM(sn_rcv_sdrfx%cldes ), ' (', TRIM(sn_rcv_sdrfx%clcat ), ')' 335 WRITE(numout,*)' Surface Stokes drift grid v = ', TRIM(sn_rcv_sdrfy%cldes ), ' (', TRIM(sn_rcv_sdrfy%clcat ), ')' 336 WRITE(numout,*)' Mean wave period = ', TRIM(sn_rcv_wper%cldes ), ' (', TRIM(sn_rcv_wper%clcat ), ')' 337 WRITE(numout,*)' Mean wave number = ', TRIM(sn_rcv_wnum%cldes ), ' (', TRIM(sn_rcv_wnum%clcat ), ')' 336 338 WRITE(numout,*)' Stress frac adsorbed by waves = ', TRIM(sn_rcv_wstrf%cldes ), ' (', TRIM(sn_rcv_wstrf%clcat ), ')' 337 WRITE(numout,*)' Neutral surf drag coefficient = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')' 339 WRITE(numout,*)' Neutral surf drag coefficient = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')' 338 340 WRITE(numout,*)' Charnock coefficient = ', TRIM(sn_rcv_charn%cldes ), ' (', TRIM(sn_rcv_charn%clcat ), ')' 339 341 WRITE(numout,*)' sent fields (multiple ice categories)' … … 342 344 WRITE(numout,*)' albedo = ', TRIM(sn_snd_alb%cldes ), ' (', TRIM(sn_snd_alb%clcat ), ')' 343 345 WRITE(numout,*)' ice/snow thickness = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')' 344 WRITE(numout,*)' total ice fraction = ', TRIM(sn_snd_ifrac%cldes ), ' (', TRIM(sn_snd_ifrac%clcat ), ')' 346 WRITE(numout,*)' total ice fraction = ', TRIM(sn_snd_ifrac%cldes ), ' (', TRIM(sn_snd_ifrac%clcat ), ')' 345 347 WRITE(numout,*)' surface current = ', TRIM(sn_snd_crt%cldes ), ' (', TRIM(sn_snd_crt%clcat ), ')' 346 WRITE(numout,*)' - referential = ', sn_snd_crt%clvref 348 WRITE(numout,*)' - referential = ', sn_snd_crt%clvref 347 349 WRITE(numout,*)' - orientation = ', sn_snd_crt%clvor 348 350 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd … … 351 353 WRITE(numout,*)' meltponds fraction and depth = ', TRIM(sn_snd_mpnd%cldes ), ' (', TRIM(sn_snd_mpnd%clcat ), ')' 352 354 WRITE(numout,*)' sea surface freezing temp = ', TRIM(sn_snd_sstfrz%cldes), ' (', TRIM(sn_snd_sstfrz%clcat), ')' 353 WRITE(numout,*)' water level = ', TRIM(sn_snd_wlev%cldes ), ' (', TRIM(sn_snd_wlev%clcat ), ')' 354 WRITE(numout,*)' mean sea level pressure = ', TRIM(sn_rcv_mslp%cldes ), ' (', TRIM(sn_rcv_mslp%clcat ), ')' 355 WRITE(numout,*)' surface current to waves = ', TRIM(sn_snd_crtw%cldes ), ' (', TRIM(sn_snd_crtw%clcat ), ')' 356 WRITE(numout,*)' - referential = ', sn_snd_crtw%clvref 357 WRITE(numout,*)' - orientation = ', sn_snd_crtw%clvor 358 WRITE(numout,*)' - mesh = ', sn_snd_crtw%clvgrd 355 WRITE(numout,*)' water level = ', TRIM(sn_snd_wlev%cldes ), ' (', TRIM(sn_snd_wlev%clcat ), ')' 356 WRITE(numout,*)' mean sea level pressure = ', TRIM(sn_rcv_mslp%cldes ), ' (', TRIM(sn_rcv_mslp%clcat ), ')' 357 WRITE(numout,*)' surface current to waves = ', TRIM(sn_snd_crtw%cldes ), ' (', TRIM(sn_snd_crtw%clcat ), ')' 358 WRITE(numout,*)' - referential = ', sn_snd_crtw%clvref 359 WRITE(numout,*)' - orientation = ', sn_snd_crtw%clvor 360 WRITE(numout,*)' - mesh = ', sn_snd_crtw%clvgrd 359 361 ENDIF 360 362 IF( lwp .AND. ln_wave) THEN ! control print … … 380 382 ! ! allocate sbccpl arrays 381 383 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 382 384 383 385 ! ================================ ! 384 386 ! Define the receive interface ! 385 387 ! ================================ ! 386 nrcvinfo(:) = OASIS_idle ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress 388 nrcvinfo(:) = OASIS_idle ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress 387 389 388 390 ! for each field: define the OASIS name (srcv(:)%clname) … … 394 396 395 397 ! ! ------------------------- ! 396 ! ! ice and ocean wind stress ! 397 ! ! ------------------------- ! 398 ! ! Name 398 ! ! ice and ocean wind stress ! 399 ! ! ------------------------- ! 400 ! ! Name 399 401 srcv(jpr_otx1)%clname = 'O_OTaux1' ! 1st ocean component on grid ONE (T or U) 400 srcv(jpr_oty1)%clname = 'O_OTauy1' ! 2nd - - - - 401 srcv(jpr_otz1)%clname = 'O_OTauz1' ! 3rd - - - - 402 srcv(jpr_oty1)%clname = 'O_OTauy1' ! 2nd - - - - 403 srcv(jpr_otz1)%clname = 'O_OTauz1' ! 3rd - - - - 402 404 srcv(jpr_otx2)%clname = 'O_OTaux2' ! 1st ocean component on grid TWO (V) 403 srcv(jpr_oty2)%clname = 'O_OTauy2' ! 2nd - - - - 404 srcv(jpr_otz2)%clname = 'O_OTauz2' ! 3rd - - - - 405 srcv(jpr_oty2)%clname = 'O_OTauy2' ! 2nd - - - - 406 srcv(jpr_otz2)%clname = 'O_OTauz2' ! 3rd - - - - 405 407 ! 406 408 srcv(jpr_itx1)%clname = 'O_ITaux1' ! 1st ice component on grid ONE (T, F, I or U) 407 srcv(jpr_ity1)%clname = 'O_ITauy1' ! 2nd - - - - 408 srcv(jpr_itz1)%clname = 'O_ITauz1' ! 3rd - - - - 409 srcv(jpr_ity1)%clname = 'O_ITauy1' ! 2nd - - - - 410 srcv(jpr_itz1)%clname = 'O_ITauz1' ! 3rd - - - - 409 411 srcv(jpr_itx2)%clname = 'O_ITaux2' ! 1st ice component on grid TWO (V) 410 srcv(jpr_ity2)%clname = 'O_ITauy2' ! 2nd - - - - 411 srcv(jpr_itz2)%clname = 'O_ITauz2' ! 3rd - - - - 412 ! 412 srcv(jpr_ity2)%clname = 'O_ITauy2' ! 2nd - - - - 413 srcv(jpr_itz2)%clname = 'O_ITauz2' ! 3rd - - - - 414 ! 413 415 ! Vectors: change of sign at north fold ONLY if on the local grid 414 416 IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM( sn_rcv_tau%cldes ) == 'oce and ice' & … … 416 418 ! 417 419 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 418 420 419 421 ! ! Set grid and action 420 422 SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) ) ! 'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V' 421 CASE( 'T' ) 423 CASE( 'T' ) 422 424 srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point 423 srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1 424 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 425 CASE( 'U,V' ) 425 srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1 426 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 427 CASE( 'U,V' ) 426 428 srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point 427 429 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point … … 447 449 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 448 450 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only 449 CASE( 'T,I' ) 451 CASE( 'T,I' ) 450 452 srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point 451 453 srcv(jpr_itx1:jpr_itz1)%clgrid = 'I' ! ice components given at I-point 452 srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1 453 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 454 CASE( 'T,F' ) 454 srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1 455 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 456 CASE( 'T,F' ) 455 457 srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point 456 458 srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point 457 srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1 458 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 459 srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1 460 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 459 461 CASE( 'T,U,V' ) 460 462 srcv(jpr_otx1:jpr_otz1)%clgrid = 'T' ! oce components given at T-point … … 463 465 srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1 only 464 466 srcv(jpr_itx1:jpr_itz2)%laction = .TRUE. ! receive ice components on grid 1 & 2 465 CASE default 467 CASE default 466 468 CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' ) 467 469 END SELECT 468 470 ! 469 471 IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' ) & ! spherical: 3rd component not received 470 & srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE. 472 & srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE. 471 473 ! 472 474 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) THEN ! already on local grid -> no need of the second grid 473 srcv(jpr_otx2:jpr_otz2)%laction = .FALSE. 474 srcv(jpr_itx2:jpr_itz2)%laction = .FALSE. 475 srcv(jpr_otx2:jpr_otz2)%laction = .FALSE. 476 srcv(jpr_itx2:jpr_itz2)%laction = .FALSE. 475 477 srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid ! not needed but cleaner... 476 478 srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid ! not needed but cleaner... … … 488 490 ! ! ------------------------- ! 489 491 ! we suppose that atmosphere modele do not make the difference between precipiration (liquide or solid) 490 ! over ice of free ocean within the same atmospheric cell.cd 492 ! over ice of free ocean within the same atmospheric cell.cd 491 493 srcv(jpr_rain)%clname = 'OTotRain' ! Rain = liquid precipitation 492 494 srcv(jpr_snow)%clname = 'OTotSnow' ! Snow = solid precipitation 493 495 srcv(jpr_tevp)%clname = 'OTotEvap' ! total evaporation (over oce + ice sublimation) 494 496 srcv(jpr_ievp)%clname = 'OIceEvap' ! evaporation over ice = sublimation 495 srcv(jpr_sbpr)%clname = 'OSubMPre' ! sublimation - liquid precipitation - solid precipitation 497 srcv(jpr_sbpr)%clname = 'OSubMPre' ! sublimation - liquid precipitation - solid precipitation 496 498 srcv(jpr_semp)%clname = 'OISubMSn' ! ice solid water budget = sublimation - solid precipitation 497 499 srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip 498 500 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 499 501 CASE( 'none' ) ! nothing to do 500 CASE( 'oce only' ) ; srcv(jpr_oemp)%laction = .TRUE. 502 CASE( 'oce only' ) ; srcv(jpr_oemp)%laction = .TRUE. 501 503 CASE( 'conservative' ) 502 504 srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. … … 507 509 ! 508 510 ! ! ------------------------- ! 509 ! ! Runoffs & Calving ! 511 ! ! Runoffs & Calving ! 510 512 ! ! ------------------------- ! 511 513 srcv(jpr_rnf )%clname = 'O_Runoff' … … 540 542 CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. 541 543 CASE( 'oce and ice' ) ; srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE. 542 CASE( 'mixed oce-ice' ) ; srcv( jpr_qnsmix )%laction = .TRUE. 544 CASE( 'mixed oce-ice' ) ; srcv( jpr_qnsmix )%laction = .TRUE. 543 545 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' ) 544 546 END SELECT … … 557 559 CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. 558 560 CASE( 'oce and ice' ) ; srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE. 559 CASE( 'mixed oce-ice' ) ; srcv( jpr_qsrmix )%laction = .TRUE. 561 CASE( 'mixed oce-ice' ) ; srcv( jpr_qsrmix )%laction = .TRUE. 560 562 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' ) 561 563 END SELECT … … 566 568 ! ! non solar sensitivity ! d(Qns)/d(T) 567 569 ! ! ------------------------- ! 568 srcv(jpr_dqnsdt)%clname = 'O_dQnsdT' 570 srcv(jpr_dqnsdt)%clname = 'O_dQnsdT' 569 571 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' ) srcv(jpr_dqnsdt)%laction = .TRUE. 570 572 ! … … 574 576 ! 575 577 ! ! ------------------------- ! 576 ! ! 10m wind module ! 577 ! ! ------------------------- ! 578 srcv(jpr_w10m)%clname = 'O_Wind10' ; IF( TRIM(sn_rcv_w10m%cldes ) == 'coupled' ) srcv(jpr_w10m)%laction = .TRUE. 579 ! 580 ! ! ------------------------- ! 581 ! ! wind stress module ! 578 ! ! 10m wind module ! 579 ! ! ------------------------- ! 580 srcv(jpr_w10m)%clname = 'O_Wind10' ; IF( TRIM(sn_rcv_w10m%cldes ) == 'coupled' ) srcv(jpr_w10m)%laction = .TRUE. 581 ! 582 ! ! ------------------------- ! 583 ! ! wind stress module ! 582 584 ! ! ------------------------- ! 583 585 srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE. … … 586 588 ! ! Atmospheric CO2 ! 587 589 ! ! ------------------------- ! 588 srcv(jpr_co2 )%clname = 'O_AtmCO2' 590 srcv(jpr_co2 )%clname = 'O_AtmCO2' 589 591 IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) THEN 590 592 srcv(jpr_co2 )%laction = .TRUE. … … 595 597 ENDIF 596 598 ! 597 ! ! ------------------------- ! 598 ! ! Mean Sea Level Pressure ! 599 ! ! ------------------------- ! 600 srcv(jpr_mslp)%clname = 'O_MSLP' ; IF( TRIM(sn_rcv_mslp%cldes ) == 'coupled' ) srcv(jpr_mslp)%laction = .TRUE. 601 ! 602 ! ! ------------------------- ! 603 ! ! ice topmelt and botmelt ! 599 ! ! ------------------------- ! 600 ! ! Mean Sea Level Pressure ! 601 ! ! ------------------------- ! 602 srcv(jpr_mslp)%clname = 'O_MSLP' ; IF( TRIM(sn_rcv_mslp%cldes ) == 'coupled' ) srcv(jpr_mslp)%laction = .TRUE. 603 ! 604 ! ! ------------------------- ! 605 ! ! ice topmelt and botmelt ! 604 606 ! ! ------------------------- ! 605 607 srcv(jpr_topm )%clname = 'OTopMlt' … … 614 616 ENDIF 615 617 ! ! ------------------------- ! 616 ! ! ice skin temperature ! 618 ! ! ice skin temperature ! 617 619 ! ! ------------------------- ! 618 620 srcv(jpr_ts_ice)%clname = 'OTsfIce' ! needed by Met Office … … 622 624 623 625 #if defined key_si3 624 IF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN 626 IF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN 625 627 IF( .NOT.srcv(jpr_ts_ice)%laction ) & 626 & CALL ctl_stop( 'sbc_cpl_init: srcv(jpr_ts_ice)%laction should be set to true when ln_cndflx=T' ) 628 & CALL ctl_stop( 'sbc_cpl_init: srcv(jpr_ts_ice)%laction should be set to true when ln_cndflx=T' ) 627 629 ENDIF 628 630 #endif 629 631 ! ! ------------------------- ! 630 ! ! Wave breaking ! 631 ! ! ------------------------- ! 632 ! ! Wave breaking ! 633 ! ! ------------------------- ! 632 634 srcv(jpr_hsig)%clname = 'O_Hsigwa' ! significant wave height 633 635 IF( TRIM(sn_rcv_hsig%cldes ) == 'coupled' ) THEN … … 704 706 ! 705 707 ! ! ------------------------------- ! 706 ! ! OPA-SAS coupling - rcv by opa ! 708 ! ! OPA-SAS coupling - rcv by opa ! 707 709 ! ! ------------------------------- ! 708 710 srcv(jpr_sflx)%clname = 'O_SFLX' … … 740 742 ENDIF 741 743 ! ! -------------------------------- ! 742 ! ! OPA-SAS coupling - rcv by sas ! 744 ! ! OPA-SAS coupling - rcv by sas ! 743 745 ! ! -------------------------------- ! 744 746 srcv(jpr_toce )%clname = 'I_SSTSST' … … 747 749 srcv(jpr_ocy1 )%clname = 'I_OCury1' 748 750 srcv(jpr_ssh )%clname = 'I_SSHght' 749 srcv(jpr_e3t1st)%clname = 'I_E3T1st' 750 srcv(jpr_fraqsr)%clname = 'I_FraQsr' 751 srcv(jpr_e3t1st)%clname = 'I_E3T1st' 752 srcv(jpr_fraqsr)%clname = 'I_FraQsr' 751 753 ! 752 754 IF( nn_components == jp_iam_sas ) THEN … … 778 780 ENDIF 779 781 WRITE(numout,*)' sea surface temperature (Celsius) ' 780 WRITE(numout,*)' sea surface salinity ' 781 WRITE(numout,*)' surface currents ' 782 WRITE(numout,*)' sea surface height ' 783 WRITE(numout,*)' thickness of first ocean T level ' 782 WRITE(numout,*)' sea surface salinity ' 783 WRITE(numout,*)' surface currents ' 784 WRITE(numout,*)' sea surface height ' 785 WRITE(numout,*)' thickness of first ocean T level ' 784 786 WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level' 785 787 WRITE(numout,*) 786 788 ENDIF 787 789 ENDIF 788 790 789 791 ! =================================================== ! 790 792 ! Allocate all parts of frcv used for received fields ! … … 812 814 ! define send or not from the namelist parameters (ssnd(:)%laction) 813 815 ! define the north fold type of lbc (ssnd(:)%nsgn) 814 816 815 817 ! default definitions of nsnd 816 818 ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1 817 819 818 820 ! ! ------------------------- ! 819 821 ! ! Surface temperature ! … … 832 834 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 833 835 END SELECT 834 836 835 837 ! ! ------------------------- ! 836 838 ! ! Albedo ! 837 839 ! ! ------------------------- ! 838 ssnd(jps_albice)%clname = 'O_AlbIce' 840 ssnd(jps_albice)%clname = 'O_AlbIce' 839 841 ssnd(jps_albmix)%clname = 'O_AlbMix' 840 842 SELECT CASE( TRIM( sn_snd_alb%cldes ) ) … … 847 849 ! Need to calculate oceanic albedo if 848 850 ! 1. sending mixed oce-ice albedo or 849 ! 2. receiving mixed oce-ice solar radiation 851 ! 2. receiving mixed oce-ice solar radiation 850 852 IF( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 851 853 CALL oce_alb( zaos, zacs ) … … 854 856 ENDIF 855 857 ! ! ------------------------- ! 856 ! ! Ice fraction & Thickness ! 858 ! ! Ice fraction & Thickness ! 857 859 ! ! ------------------------- ! 858 860 ssnd(jps_fice)%clname = 'OIceFrc' 859 ssnd(jps_ficet)%clname = 'OIceFrcT' 861 ssnd(jps_ficet)%clname = 'OIceFrcT' 860 862 ssnd(jps_hice)%clname = 'OIceTck' 861 863 ssnd(jps_a_p)%clname = 'OPndFrc' … … 870 872 IF( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl 871 873 ENDIF 872 873 IF(TRIM( sn_snd_ifrac%cldes ) == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 874 875 IF(TRIM( sn_snd_ifrac%cldes ) == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 874 876 875 877 SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 876 878 CASE( 'none' ) ! nothing to do 877 CASE( 'ice and snow' ) 879 CASE( 'ice and snow' ) 878 880 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 879 881 IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 880 882 ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 881 883 ENDIF 882 CASE ( 'weighted ice and snow' ) 884 CASE ( 'weighted ice and snow' ) 883 885 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 884 886 IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl … … 890 892 a_i_last_couple(:,:,:) = 0._wp 891 893 #endif 892 ! ! ------------------------- ! 893 ! ! Ice Meltponds ! 894 ! ! ------------------------- ! 894 ! ! ------------------------- ! 895 ! ! Ice Meltponds ! 896 ! ! ------------------------- ! 895 897 ! Needed by Met Office 896 ssnd(jps_a_p)%clname = 'OPndFrc' 897 ssnd(jps_ht_p)%clname = 'OPndTck' 898 SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) ) 899 CASE ( 'none' ) 900 ssnd(jps_a_p)%laction = .FALSE. 901 ssnd(jps_ht_p)%laction = .FALSE. 902 CASE ( 'ice only' ) 903 ssnd(jps_a_p)%laction = .TRUE. 904 ssnd(jps_ht_p)%laction = .TRUE. 905 IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 906 ssnd(jps_a_p)%nct = nn_cats_cpl 907 ssnd(jps_ht_p)%nct = nn_cats_cpl 908 ELSE 909 IF( nn_cats_cpl > 1 ) THEN 910 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 911 ENDIF 912 ENDIF 913 CASE ( 'weighted ice' ) 914 ssnd(jps_a_p)%laction = .TRUE. 915 ssnd(jps_ht_p)%laction = .TRUE. 916 IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 917 ssnd(jps_a_p)%nct = nn_cats_cpl 918 ssnd(jps_ht_p)%nct = nn_cats_cpl 919 ENDIF 920 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes; '//sn_snd_mpnd%cldes ) 921 END SELECT 922 898 ssnd(jps_a_p)%clname = 'OPndFrc' 899 ssnd(jps_ht_p)%clname = 'OPndTck' 900 SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) ) 901 CASE ( 'none' ) 902 ssnd(jps_a_p)%laction = .FALSE. 903 ssnd(jps_ht_p)%laction = .FALSE. 904 CASE ( 'ice only' ) 905 ssnd(jps_a_p)%laction = .TRUE. 906 ssnd(jps_ht_p)%laction = .TRUE. 907 IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 908 ssnd(jps_a_p)%nct = nn_cats_cpl 909 ssnd(jps_ht_p)%nct = nn_cats_cpl 910 ELSE 911 IF( nn_cats_cpl > 1 ) THEN 912 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 913 ENDIF 914 ENDIF 915 CASE ( 'weighted ice' ) 916 ssnd(jps_a_p)%laction = .TRUE. 917 ssnd(jps_ht_p)%laction = .TRUE. 918 IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 919 ssnd(jps_a_p)%nct = nn_cats_cpl 920 ssnd(jps_ht_p)%nct = nn_cats_cpl 921 ENDIF 922 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes; '//sn_snd_mpnd%cldes ) 923 END SELECT 924 923 925 ! ! ------------------------- ! 924 926 ! ! Surface current ! … … 928 930 ssnd(jps_ocy1)%clname = 'O_OCury1' ; ssnd(jps_ivy1)%clname = 'O_IVely1' 929 931 ssnd(jps_ocz1)%clname = 'O_OCurz1' ; ssnd(jps_ivz1)%clname = 'O_IVelz1' 930 ssnd(jps_ocxw)%clname = 'O_OCurxw' 931 ssnd(jps_ocyw)%clname = 'O_OCuryw' 932 ssnd(jps_ocxw)%clname = 'O_OCurxw' 933 ssnd(jps_ocyw)%clname = 'O_OCuryw' 932 934 ! 933 935 ssnd(jps_ocx1:jps_ivz1)%nsgn = -1. ! vectors: change of the sign at the north fold … … 935 937 IF( sn_snd_crt%clvgrd == 'U,V' ) THEN 936 938 ssnd(jps_ocx1)%clgrid = 'U' ; ssnd(jps_ocy1)%clgrid = 'V' 937 ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN 939 ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN 938 940 CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' ) 939 941 ENDIF 940 942 ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE. ! default: all are send 941 IF( TRIM( sn_snd_crt%clvref ) == 'spherical' ) ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE. 943 IF( TRIM( sn_snd_crt%clvref ) == 'spherical' ) ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE. 942 944 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) ssnd(jps_ocx1:jps_ivz1)%nsgn = 1. 943 945 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) … … 949 951 END SELECT 950 952 951 ssnd(jps_ocxw:jps_ocyw)%nsgn = -1. ! vectors: change of the sign at the north fold 952 953 IF( sn_snd_crtw%clvgrd == 'U,V' ) THEN 954 ssnd(jps_ocxw)%clgrid = 'U' ; ssnd(jps_ocyw)%clgrid = 'V' 955 ELSE IF( sn_snd_crtw%clvgrd /= 'T' ) THEN 956 CALL ctl_stop( 'sn_snd_crtw%clvgrd must be equal to T' ) 957 ENDIF 958 IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) ssnd(jps_ocxw:jps_ocyw)%nsgn = 1. 959 SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 960 CASE( 'none' ) ; ssnd(jps_ocxw:jps_ocyw)%laction = .FALSE. 961 CASE( 'oce only' ) ; ssnd(jps_ocxw:jps_ocyw)%laction = .TRUE. 962 CASE( 'weighted oce and ice' ) ! nothing to do 963 CASE( 'mixed oce-ice' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 964 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crtw%cldes' ) 965 END SELECT 953 ssnd(jps_ocxw:jps_ocyw)%nsgn = -1. ! vectors: change of the sign at the north fold 954 955 IF( sn_snd_crtw%clvgrd == 'U,V' ) THEN 956 ssnd(jps_ocxw)%clgrid = 'U' ; ssnd(jps_ocyw)%clgrid = 'V' 957 ELSE IF( sn_snd_crtw%clvgrd /= 'T' ) THEN 958 CALL ctl_stop( 'sn_snd_crtw%clvgrd must be equal to T' ) 959 ENDIF 960 IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) ssnd(jps_ocxw:jps_ocyw)%nsgn = 1. 961 SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 962 CASE( 'none' ) ; ssnd(jps_ocxw:jps_ocyw)%laction = .FALSE. 963 CASE( 'oce only' ) ; ssnd(jps_ocxw:jps_ocyw)%laction = .TRUE. 964 CASE( 'weighted oce and ice' ) ! nothing to do 965 CASE( 'mixed oce-ice' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 966 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crtw%cldes' ) 967 END SELECT 966 968 967 969 ! ! ------------------------- ! … … 969 971 ! ! ------------------------- ! 970 972 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 971 ! 972 ! ! ------------------------- ! 973 ! ! Sea surface freezing temp ! 974 ! ! ------------------------- ! 973 ! 974 ! ! ------------------------- ! 975 ! ! Sea surface freezing temp ! 976 ! ! ------------------------- ! 975 977 ! needed by Met Office 976 ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' ) ssnd(jps_sstfrz)%laction = .TRUE. 977 ! 978 ! ! ------------------------- ! 979 ! ! Ice conductivity ! 980 ! ! ------------------------- ! 978 ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' ) ssnd(jps_sstfrz)%laction = .TRUE. 979 ! 980 ! ! ------------------------- ! 981 ! ! Ice conductivity ! 982 ! ! ------------------------- ! 981 983 ! needed by Met Office 982 ! Note that ultimately we will move to passing an ocean effective conductivity as well so there 983 ! will be some changes to the parts of the code which currently relate only to ice conductivity 984 ssnd(jps_ttilyr )%clname = 'O_TtiLyr' 985 SELECT CASE ( TRIM( sn_snd_ttilyr%cldes ) ) 986 CASE ( 'none' ) 987 ssnd(jps_ttilyr)%laction = .FALSE. 988 CASE ( 'ice only' ) 989 ssnd(jps_ttilyr)%laction = .TRUE. 990 IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN 991 ssnd(jps_ttilyr)%nct = nn_cats_cpl 992 ELSE 993 IF( nn_cats_cpl > 1 ) THEN 994 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' ) 995 ENDIF 996 ENDIF 997 CASE ( 'weighted ice' ) 998 ssnd(jps_ttilyr)%laction = .TRUE. 999 IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl 1000 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes ) 1001 END SELECT 1002 1003 ssnd(jps_kice )%clname = 'OIceKn' 1004 SELECT CASE ( TRIM( sn_snd_cond%cldes ) ) 1005 CASE ( 'none' ) 1006 ssnd(jps_kice)%laction = .FALSE. 1007 CASE ( 'ice only' ) 1008 ssnd(jps_kice)%laction = .TRUE. 1009 IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 1010 ssnd(jps_kice)%nct = nn_cats_cpl 1011 ELSE 1012 IF( nn_cats_cpl > 1 ) THEN 1013 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 1014 ENDIF 1015 ENDIF 1016 CASE ( 'weighted ice' ) 1017 ssnd(jps_kice)%laction = .TRUE. 1018 IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl 1019 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes ) 1020 END SELECT 1021 ! 1022 ! ! ------------------------- ! 1023 ! ! Sea surface height ! 1024 ! ! ------------------------- ! 1025 ssnd(jps_wlev)%clname = 'O_Wlevel' ; IF( TRIM(sn_snd_wlev%cldes) == 'coupled' ) ssnd(jps_wlev)%laction = .TRUE. 984 ! Note that ultimately we will move to passing an ocean effective conductivity as well so there 985 ! will be some changes to the parts of the code which currently relate only to ice conductivity 986 ssnd(jps_ttilyr )%clname = 'O_TtiLyr' 987 SELECT CASE ( TRIM( sn_snd_ttilyr%cldes ) ) 988 CASE ( 'none' ) 989 ssnd(jps_ttilyr)%laction = .FALSE. 990 CASE ( 'ice only' ) 991 ssnd(jps_ttilyr)%laction = .TRUE. 992 IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN 993 ssnd(jps_ttilyr)%nct = nn_cats_cpl 994 ELSE 995 IF( nn_cats_cpl > 1 ) THEN 996 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' ) 997 ENDIF 998 ENDIF 999 CASE ( 'weighted ice' ) 1000 ssnd(jps_ttilyr)%laction = .TRUE. 1001 IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl 1002 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes ) 1003 END SELECT 1004 1005 ssnd(jps_kice )%clname = 'OIceKn' 1006 SELECT CASE ( TRIM( sn_snd_cond%cldes ) ) 1007 CASE ( 'none' ) 1008 ssnd(jps_kice)%laction = .FALSE. 1009 CASE ( 'ice only' ) 1010 ssnd(jps_kice)%laction = .TRUE. 1011 IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 1012 ssnd(jps_kice)%nct = nn_cats_cpl 1013 ELSE 1014 IF( nn_cats_cpl > 1 ) THEN 1015 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 1016 ENDIF 1017 ENDIF 1018 CASE ( 'weighted ice' ) 1019 ssnd(jps_kice)%laction = .TRUE. 1020 IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl 1021 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes ) 1022 END SELECT 1023 ! 1024 ! ! ------------------------- ! 1025 ! ! Sea surface height ! 1026 ! ! ------------------------- ! 1027 ssnd(jps_wlev)%clname = 'O_Wlevel' ; IF( TRIM(sn_snd_wlev%cldes) == 'coupled' ) ssnd(jps_wlev)%laction = .TRUE. 1026 1028 1027 1029 ! ! ------------------------------- ! 1028 ! ! OPA-SAS coupling - snd by opa ! 1030 ! ! OPA-SAS coupling - snd by opa ! 1029 1031 ! ! ------------------------------- ! 1030 ssnd(jps_ssh )%clname = 'O_SSHght' 1031 ssnd(jps_soce )%clname = 'O_SSSal' 1032 ssnd(jps_e3t1st)%clname = 'O_E3T1st' 1032 ssnd(jps_ssh )%clname = 'O_SSHght' 1033 ssnd(jps_soce )%clname = 'O_SSSal' 1034 ssnd(jps_e3t1st)%clname = 'O_E3T1st' 1033 1035 ssnd(jps_fraqsr)%clname = 'O_FraQsr' 1034 1036 ! … … 1048 1050 WRITE(numout,*)' sent fields to SAS component ' 1049 1051 WRITE(numout,*)' sea surface temperature (T before, Celsius) ' 1050 WRITE(numout,*)' sea surface salinity ' 1051 WRITE(numout,*)' surface currents U,V on local grid and spherical coordinates' 1052 WRITE(numout,*)' sea surface height ' 1053 WRITE(numout,*)' thickness of first ocean T level ' 1052 WRITE(numout,*)' sea surface salinity ' 1053 WRITE(numout,*)' surface currents U,V on local grid and spherical coordinates' 1054 WRITE(numout,*)' sea surface height ' 1055 WRITE(numout,*)' thickness of first ocean T level ' 1054 1056 WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level' 1055 1057 WRITE(numout,*) … … 1057 1059 ENDIF 1058 1060 ! ! ------------------------------- ! 1059 ! ! OPA-SAS coupling - snd by sas ! 1061 ! ! OPA-SAS coupling - snd by sas ! 1060 1062 ! ! ------------------------------- ! 1061 ssnd(jps_sflx )%clname = 'I_SFLX' 1063 ssnd(jps_sflx )%clname = 'I_SFLX' 1062 1064 ssnd(jps_fice2 )%clname = 'IIceFrc' 1063 ssnd(jps_qsroce)%clname = 'I_QsrOce' 1064 ssnd(jps_qnsoce)%clname = 'I_QnsOce' 1065 ssnd(jps_oemp )%clname = 'IOEvaMPr' 1066 ssnd(jps_otx1 )%clname = 'I_OTaux1' 1067 ssnd(jps_oty1 )%clname = 'I_OTauy1' 1068 ssnd(jps_rnf )%clname = 'I_Runoff' 1069 ssnd(jps_taum )%clname = 'I_TauMod' 1065 ssnd(jps_qsroce)%clname = 'I_QsrOce' 1066 ssnd(jps_qnsoce)%clname = 'I_QnsOce' 1067 ssnd(jps_oemp )%clname = 'IOEvaMPr' 1068 ssnd(jps_otx1 )%clname = 'I_OTaux1' 1069 ssnd(jps_oty1 )%clname = 'I_OTauy1' 1070 ssnd(jps_rnf )%clname = 'I_Runoff' 1071 ssnd(jps_taum )%clname = 'I_TauMod' 1070 1072 ! 1071 1073 IF( nn_components == jp_iam_sas ) THEN … … 1102 1104 ! ================================ ! 1103 1105 CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 1104 1105 IF(ln_usecplmask) THEN 1106 1107 IF(ln_usecplmask) THEN 1106 1108 xcplmask(:,:,:) = 0. 1107 1109 CALL iom_open( 'cplmask', inum ) … … 1118 1120 1119 1121 1120 SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice, Kbb, Kmm ) 1122 SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice, Kbb, Kmm ) 1121 1123 !!---------------------------------------------------------------------- 1122 1124 !! *** ROUTINE sbc_cpl_rcv *** … … 1132 1134 !! 1133 1135 !! - transform the received ocean stress vector from the received 1134 !! referential and grid into an atmosphere-ocean stress in 1135 !! the (i,j) ocean referencial and at the ocean velocity point. 1136 !! referential and grid into an atmosphere-ocean stress in 1137 !! the (i,j) ocean referencial and at the ocean velocity point. 1136 1138 !! The received stress are : 1137 1139 !! - defined by 3 components (if cartesian coordinate) … … 1141 1143 !! - given at U- and V-point, resp. if received on 2 grids 1142 1144 !! or at T-point if received on 1 grid 1143 !! Therefore and if necessary, they are successively 1144 !! processed in order to obtain them 1145 !! first as 2 components on the sphere 1145 !! Therefore and if necessary, they are successively 1146 !! processed in order to obtain them 1147 !! first as 2 components on the sphere 1146 1148 !! second as 2 components oriented along the local grid 1147 !! third as 2 components on the U,V grid 1149 !! third as 2 components on the U,V grid 1148 1150 !! 1149 !! --> 1151 !! --> 1150 1152 !! 1151 !! - In 'ocean only' case, non solar and solar ocean heat fluxes 1152 !! and total ocean freshwater fluxes 1153 !! - In 'ocean only' case, non solar and solar ocean heat fluxes 1154 !! and total ocean freshwater fluxes 1153 1155 !! 1154 !! ** Method : receive all fields from the atmosphere and transform 1155 !! them into ocean surface boundary condition fields 1156 !! ** Method : receive all fields from the atmosphere and transform 1157 !! them into ocean surface boundary condition fields 1156 1158 !! 1157 !! ** Action : update utau, vtau ocean stress at U,V grid 1159 !! ** Action : update utau, vtau ocean stress at U,V grid 1158 1160 !! taum wind stress module at T-point 1159 1161 !! wndm wind speed module at T-point over free ocean or leads in presence of sea-ice … … 1166 1168 ! 1167 1169 INTEGER, INTENT(in) :: kt ! ocean model time step index 1168 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 1170 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 1169 1171 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 1170 1172 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean model time level indices … … 1173 1175 INTEGER :: ji, jj, jn ! dummy loop indices 1174 1176 INTEGER :: isec ! number of seconds since nit000 (assuming rdt did not change since nit000) 1175 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 1177 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 1176 1178 REAL(wp) :: zcoef ! temporary scalar 1177 1179 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 … … 1188 1190 1189 1191 IF( ncpl_qsr_freq /= 0) ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top 1190 1192 1191 1193 IF ( ln_wave .AND. nn_components == 0 ) THEN 1192 1194 ncpl_qsr_freq = 1; … … 1231 1233 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 1232 1234 ! ! (geographical to local grid -> rotate the components) 1233 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 1235 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 1234 1236 IF( srcv(jpr_otx2)%laction ) THEN 1235 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1237 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1236 1238 ELSE 1237 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1239 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1238 1240 ENDIF 1239 1241 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 1240 1242 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 1241 1243 ENDIF 1242 ! 1244 ! 1243 1245 IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN 1244 1246 DO_2D( 0, 0, 0, 0 ) ! T ==> (U,V) … … 1255 1257 ELSE ! No dynamical coupling ! 1256 1258 ! ! ========================= ! 1257 frcv(jpr_otx1)%z3(:,:,1) = 0.e0 ! here simply set to zero 1259 frcv(jpr_otx1)%z3(:,:,1) = 0.e0 ! here simply set to zero 1258 1260 frcv(jpr_oty1)%z3(:,:,1) = 0.e0 ! an external read in a file can be added instead 1259 1261 llnewtx = .TRUE. … … 1263 1265 ! ! wind stress module ! (taum) 1264 1266 ! ! ========================= ! 1265 IF( .NOT. srcv(jpr_taum)%laction ) THEN ! compute wind stress module from its components if not received 1267 IF( .NOT. srcv(jpr_taum)%laction ) THEN ! compute wind stress module from its components if not received 1266 1268 ! => need to be done only when otx1 was changed 1267 1269 IF( llnewtx ) THEN … … 1279 1281 llnewtau = nrcvinfo(jpr_taum) == OASIS_Rcv 1280 1282 ! Stress module can be negative when received (interpolation problem) 1281 IF( llnewtau ) THEN 1283 IF( llnewtau ) THEN 1282 1284 frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) ) 1283 1285 ENDIF … … 1287 1289 ! ! 10 m wind speed ! (wndm) 1288 1290 ! ! ========================= ! 1289 IF( .NOT. srcv(jpr_w10m)%laction ) THEN ! compute wind spreed from wind stress module if not received 1291 IF( .NOT. srcv(jpr_w10m)%laction ) THEN ! compute wind spreed from wind stress module if not received 1290 1292 ! => need to be done only when taumod was changed 1291 IF( llnewtau ) THEN 1292 zcoef = 1. / ( zrhoa * zcdrag ) 1293 IF( llnewtau ) THEN 1294 zcoef = 1. / ( zrhoa * zcdrag ) 1293 1295 DO_2D( 1, 1, 1, 1 ) 1294 1296 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) … … 1310 1312 ! ! ========================= ! 1311 1313 ! u(v)tau and taum will be modified by ice model 1312 ! -> need to be reset before each call of the ice/fsbc 1314 ! -> need to be reset before each call of the ice/fsbc 1313 1315 IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 1314 1316 ! … … 1325 1327 ENDIF 1326 1328 CALL iom_put( "taum_oce", taum ) ! output wind stress module 1327 ! 1329 ! 1328 1330 ENDIF 1329 1331 … … 1333 1335 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 1334 1336 ! 1335 ! ! ========================= ! 1336 ! ! Mean Sea Level Pressure ! (taum) 1337 ! ! ========================= ! 1338 IF( srcv(jpr_mslp)%laction ) THEN ! UKMO SHELF effect of atmospheric pressure on SSH 1339 IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields 1340 1341 r1_grau = 1.e0 / (grav * rho0) !* constant for optimization 1342 ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau ! equivalent ssh (inverse barometer) 1343 apr (:,:) = frcv(jpr_mslp)%z3(:,:,1) !atmospheric pressure 1344 1345 IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) ! correct this later (read from restart if possible) 1346 ENDIF 1337 ! ! ========================= ! 1338 ! ! Mean Sea Level Pressure ! (taum) 1339 ! ! ========================= ! 1340 IF( srcv(jpr_mslp)%laction ) THEN ! UKMO SHELF effect of atmospheric pressure on SSH 1341 IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields 1342 1343 r1_grau = 1.e0 / (grav * rho0) !* constant for optimization 1344 ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau ! equivalent ssh (inverse barometer) 1345 apr (:,:) = frcv(jpr_mslp)%z3(:,:,1) !atmospheric pressure 1346 1347 IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) ! correct this later (read from restart if possible) 1348 ENDIF 1347 1349 ! 1348 1350 IF( ln_sdw ) THEN ! Stokes Drift correction activated 1349 ! ! ========================= ! 1351 ! ! ========================= ! 1350 1352 ! ! Stokes drift u ! 1351 ! ! ========================= ! 1353 ! ! ========================= ! 1352 1354 IF( srcv(jpr_sdrftx)%laction ) ut0sd(:,:) = frcv(jpr_sdrftx)%z3(:,:,1) 1353 1355 ! 1354 ! ! ========================= ! 1356 ! ! ========================= ! 1355 1357 ! ! Stokes drift v ! 1356 ! ! ========================= ! 1358 ! ! ========================= ! 1357 1359 IF( srcv(jpr_sdrfty)%laction ) vt0sd(:,:) = frcv(jpr_sdrfty)%z3(:,:,1) 1358 1360 ! 1359 ! ! ========================= ! 1361 ! ! ========================= ! 1360 1362 ! ! Wave mean period ! 1361 ! ! ========================= ! 1363 ! ! ========================= ! 1362 1364 IF( srcv(jpr_wper)%laction ) wmp(:,:) = frcv(jpr_wper)%z3(:,:,1) 1363 1365 ! 1364 ! ! ========================= ! 1366 ! ! ========================= ! 1365 1367 ! ! Significant wave height ! 1366 ! ! ========================= ! 1368 ! ! ========================= ! 1367 1369 IF( srcv(jpr_hsig)%laction ) hsw(:,:) = frcv(jpr_hsig)%z3(:,:,1) 1368 ! 1369 ! ! ========================= ! 1370 ! 1371 ! ! ========================= ! 1370 1372 ! ! Vertical mixing Qiao ! 1371 ! ! ========================= ! 1373 ! ! ========================= ! 1372 1374 IF( srcv(jpr_wnum)%laction .AND. ln_zdfswm ) wnum(:,:) = frcv(jpr_wnum)%z3(:,:,1) 1373 1375 … … 1378 1380 ENDIF 1379 1381 ENDIF 1380 ! ! ========================= ! 1382 ! ! ========================= ! 1381 1383 ! ! Stress adsorbed by waves ! 1382 ! ! ========================= ! 1384 ! ! ========================= ! 1383 1385 IF( srcv(jpr_wstrf)%laction .AND. ln_tauoc ) tauoc_wave(:,:) = frcv(jpr_wstrf)%z3(:,:,1) 1384 1386 ! 1385 ! ! ========================= ! 1387 ! ! ========================= ! 1386 1388 ! ! Wave drag coefficient ! 1387 ! ! ========================= ! 1389 ! ! ========================= ! 1388 1390 IF( srcv(jpr_wdrag)%laction .AND. ln_cdgw ) cdn_wave(:,:) = frcv(jpr_wdrag)%z3(:,:,1) 1389 1391 ! … … 1404 1406 IF( srcv(jpr_twox)%laction .AND. ln_taw ) twox(:,:) = frcv(jpr_twox)%z3(:,:,1) 1405 1407 IF( srcv(jpr_twoy)%laction .AND. ln_taw ) twoy(:,:) = frcv(jpr_twoy)%z3(:,:,1) 1406 ! 1408 ! 1407 1409 ! ! ========================= ! 1408 1410 ! ! wave TKE flux at sfc ! … … 1434 1436 CALL iom_put( 'sss_m', sss_m ) 1435 1437 ENDIF 1436 ! 1438 ! 1437 1439 ! ! ================== ! 1438 1440 ! ! SST ! … … 1480 1482 CALL iom_put( 'frq_m', frq_m ) 1481 1483 ENDIF 1482 1484 1483 1485 ! ! ========================= ! 1484 1486 IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN ! heat & freshwater fluxes ! (Ocean only case) … … 1502 1504 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1503 1505 IF( srcv(jpr_cal)%laction ) zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 1504 1505 IF( srcv(jpr_icb)%laction ) THEN 1506 1507 IF( srcv(jpr_icb)%laction ) THEN 1506 1508 fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 1507 1509 rnf(:,:) = rnf(:,:) + fwficb(:,:) ! iceberg added to runfofs … … 1510 1512 ! ice shelf fwf 1511 1513 IF( srcv(jpr_isf)%laction ) THEN 1512 fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting) 1514 fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting) 1513 1515 END IF 1514 1516 1515 1517 IF( ln_mixcpl ) THEN ; emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 1516 1518 ELSE ; emp(:,:) = zemp(:,:) … … 1554 1556 ! 1555 1557 END SUBROUTINE sbc_cpl_rcv 1556 1557 1558 SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj ) 1558 1559 1560 SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj ) 1559 1561 !!---------------------------------------------------------------------- 1560 1562 !! *** ROUTINE sbc_cpl_ice_tau *** 1561 1563 !! 1562 !! ** Purpose : provide the stress over sea-ice in coupled mode 1564 !! ** Purpose : provide the stress over sea-ice in coupled mode 1563 1565 !! 1564 1566 !! ** Method : transform the received stress from the atmosphere into 1565 1567 !! an atmosphere-ice stress in the (i,j) ocean referencial 1566 1568 !! and at the velocity point of the sea-ice model: 1567 !! 'C'-grid : i- (j-) components given at U- (V-) point 1569 !! 'C'-grid : i- (j-) components given at U- (V-) point 1568 1570 !! 1569 1571 !! The received stress are : … … 1574 1576 !! - given at U- and V-point, resp. if received on 2 grids 1575 1577 !! or at a same point (T or I) if received on 1 grid 1576 !! Therefore and if necessary, they are successively 1577 !! processed in order to obtain them 1578 !! first as 2 components on the sphere 1578 !! Therefore and if necessary, they are successively 1579 !! processed in order to obtain them 1580 !! first as 2 components on the sphere 1579 1581 !! second as 2 components oriented along the local grid 1580 !! third as 2 components on the ice grid point 1582 !! third as 2 components on the ice grid point 1581 1583 !! 1582 !! Except in 'oce and ice' case, only one vector stress field 1584 !! Except in 'oce and ice' case, only one vector stress field 1583 1585 !! is received. It has already been processed in sbc_cpl_rcv 1584 1586 !! so that it is now defined as (i,j) components given at U- 1585 !! and V-points, respectively. 1587 !! and V-points, respectively. 1586 1588 !! 1587 1589 !! ** Action : return ptau_i, ptau_j, the stress over the ice … … 1593 1595 INTEGER :: itx ! index of taux over ice 1594 1596 REAL(wp) :: zztmp1, zztmp2 1595 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty 1597 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty 1596 1598 !!---------------------------------------------------------------------- 1597 1599 ! 1598 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 1600 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 1599 1601 ELSE ; itx = jpr_otx1 1600 1602 ENDIF … … 1605 1607 IF( srcv(jpr_itx1)%laction ) THEN ! ice stress received ! 1606 1608 ! ! ======================= ! 1607 ! 1609 ! 1608 1610 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere 1609 1611 ! ! (cartesian to spherical -> 3 to 2 components) … … 1624 1626 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 1625 1627 ! ! (geographical to local grid -> rotate the components) 1626 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx ) 1628 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx ) 1627 1629 IF( srcv(jpr_itx2)%laction ) THEN 1628 CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty ) 1630 CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty ) 1629 1631 ELSE 1630 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty ) 1632 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty ) 1631 1633 ENDIF 1632 1634 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid … … 1643 1645 ! ! put on ice grid ! 1644 1646 ! ! ======================= ! 1645 ! 1647 ! 1646 1648 ! j+1 j -----V---F 1647 1649 ! ice stress on ice velocity point ! | … … 1658 1660 CASE( 'T' ) 1659 1661 DO_2D( 0, 0, 0, 0 ) ! T ==> (U,V) 1660 ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology 1662 ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology 1661 1663 zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj ,1) ) 1662 1664 zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji ,jj+1,1) ) … … 1666 1668 CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. ) 1667 1669 END SELECT 1668 1670 1669 1671 ENDIF 1670 1672 ! 1671 1673 END SUBROUTINE sbc_cpl_ice_tau 1672 1674 1673 1675 1674 1676 SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi ) … … 1679 1681 !! 1680 1682 !! ** Method : transform the fields received from the atmosphere into 1681 !! surface heat and fresh water boundary condition for the 1683 !! surface heat and fresh water boundary condition for the 1682 1684 !! ice-ocean system. The following fields are provided: 1683 !! * total non solar, solar and freshwater fluxes (qns_tot, 1685 !! * total non solar, solar and freshwater fluxes (qns_tot, 1684 1686 !! qsr_tot and emp_tot) (total means weighted ice-ocean flux) 1685 1687 !! NB: emp_tot include runoffs and calving. 1686 1688 !! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where 1687 1689 !! emp_ice = sublimation - solid precipitation as liquid 1688 !! precipitation are re-routed directly to the ocean and 1690 !! precipitation are re-routed directly to the ocean and 1689 1691 !! calving directly enter the ocean (runoffs are read but included in trasbc.F90) 1690 !! * solid precipitation (sprecip), used to add to qns_tot 1692 !! * solid precipitation (sprecip), used to add to qns_tot 1691 1693 !! the heat lost associated to melting solid precipitation 1692 1694 !! over the ocean fraction. … … 1720 1722 !! emp_ice ice sublimation - solid precipitation over the ice 1721 1723 !! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice 1722 !! sprecip solid precipitation over the ocean 1724 !! sprecip solid precipitation over the ocean 1723 1725 !!---------------------------------------------------------------------- 1724 1726 REAL(wp), INTENT(in) , DIMENSION(:,:) :: picefr ! ice fraction [0 to 1] 1725 1727 ! !! ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling 1726 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1728 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1727 1729 REAL(wp), INTENT(in) , DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1728 1730 REAL(wp), INTENT(inout), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] => inout for Met-Office … … 1761 1763 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1762 1764 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 1763 CASE( 'none' ) ! Not available as for now: needs additional coding below when computing zevap_oce 1765 CASE( 'none' ) ! Not available as for now: needs additional coding below when computing zevap_oce 1764 1766 ! ! since fields received are not defined with none option 1765 1767 CALL ctl_stop( 'STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_emp value in namelist namsbc_cpl' ) … … 1808 1810 ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 1809 1811 zsnw(:,:) = 0._wp ; CALL ice_var_snwblow( ziceld, zsnw ) 1810 1812 1811 1813 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 1812 1814 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( picefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip … … 1819 1821 ! therefore, sublimation is not redistributed over the ice categories when no subgrid scale fluxes are provided by atm. 1820 1822 zdevap_ice(:,:) = 0._wp 1821 1823 1822 1824 ! --- Continental fluxes --- ! 1823 1825 IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on) … … 1833 1835 ENDIF 1834 1836 IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting) 1835 fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) 1837 fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) 1836 1838 ENDIF 1837 1839 … … 1849 1851 emp_tot (:,:) = zemp_tot (:,:) 1850 1852 emp_ice (:,:) = zemp_ice (:,:) 1851 emp_oce (:,:) = zemp_oce (:,:) 1853 emp_oce (:,:) = zemp_oce (:,:) 1852 1854 sprecip (:,:) = zsprecip (:,:) 1853 1855 tprecip (:,:) = ztprecip (:,:) … … 1896 1898 IF( iom_use('snowpre') ) CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1897 1899 IF( iom_use('precip') ) CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation 1898 IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation 1900 IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation 1899 1901 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1900 1902 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) … … 1912 1914 ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 1913 1915 ! here so the only flux is the ocean only one. 1914 zqns_ice(:,:,:) = 0._wp 1916 zqns_ice(:,:,:) = 0._wp 1915 1917 CASE( 'conservative' ) ! the required fields are directly provided 1916 1918 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) … … 1926 1928 IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1927 1929 DO jl=1,jpl 1928 zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) 1930 zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) 1929 1931 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 1930 1932 ENDDO … … 1952 1954 ENDIF 1953 1955 END SELECT 1954 ! 1956 ! 1955 1957 ! --- calving (removed from qns_tot) --- ! 1956 1958 IF( srcv(jpr_cal)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * rLfus ! remove latent heat of calving … … 1959 1961 IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove latent heat of iceberg melting 1960 1962 1961 #if defined key_si3 1963 #if defined key_si3 1962 1964 ! --- non solar flux over ocean --- ! 1963 1965 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax … … 1970 1972 ENDWHERE 1971 1973 ! Heat content per unit mass of rain (J/kg) 1972 zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) ) 1974 zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) ) 1973 1975 1974 1976 ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! … … 1987 1989 !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * zcptsnw (:,:) & ! ice evap 1988 1990 !! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhos ! solid precip over ice 1989 1991 1990 1992 ! --- total non solar flux (including evap/precip) --- ! 1991 1993 zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:) 1992 1994 1993 ! --- in case both coupled/forced are active, we must mix values --- ! 1995 ! --- in case both coupled/forced are active, we must mix values --- ! 1994 1996 IF( ln_mixcpl ) THEN 1995 1997 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) … … 2015 2017 zcptsnw (:,:) = zcptn(:,:) 2016 2018 zcptrain(:,:) = zcptn(:,:) 2017 2019 2018 2020 ! clem: this formulation is certainly wrong... but better than it was... 2019 2021 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 2020 2022 & - ( ziceld(:,:) * zsprecip(:,:) * rLfus ) & ! remove the latent heat flux of solid precip. melting 2021 2023 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 2022 & - zemp_ice(:,:) ) * zcptn(:,:) 2024 & - zemp_ice(:,:) ) * zcptn(:,:) 2023 2025 2024 2026 IF( ln_mixcpl ) THEN … … 2045 2047 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 2046 2048 & * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean) 2047 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 2049 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 2048 2050 & * zsnw(:,:) ) ! heat flux from snow (over ice) 2049 2051 ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. … … 2071 2073 IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 2072 2074 DO jl = 1, jpl 2073 zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) 2075 zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) 2074 2076 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 2075 2077 END DO … … 2098 2100 END DO 2099 2101 ENDIF 2100 CASE( 'none' ) ! Not available as for now: needs additional coding 2102 CASE( 'none' ) ! Not available as for now: needs additional coding 2101 2103 ! ! since fields received, here zqsr_tot, are not defined with none option 2102 2104 CALL ctl_stop( 'STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_qsr value in namelist namsbc_cpl' ) … … 2142 2144 ENDDO 2143 2145 ENDIF 2144 CASE( 'none' ) 2146 CASE( 'none' ) 2145 2147 zdqns_ice(:,:,:) = 0._wp 2146 2148 END SELECT 2147 2149 2148 2150 IF( ln_mixcpl ) THEN 2149 2151 DO jl=1,jpl … … 2154 2156 ENDIF 2155 2157 2156 #if defined key_si3 2158 #if defined key_si3 2157 2159 ! ! ========================= ! 2158 2160 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt ! … … 2186 2188 ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:) ! surface transmission when hi>10cm 2187 2189 DO jl = 1, jpl 2188 WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 2190 WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 2189 2191 zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 2190 2192 ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm 2191 2193 zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ztri(:,:) 2192 2194 ELSEWHERE ! zero when hs>0 2193 zqtr_ice_top(:,:,jl) = 0._wp 2195 zqtr_ice_top(:,:,jl) = 0._wp 2194 2196 END WHERE 2195 2197 ENDDO … … 2200 2202 zqtr_ice_top(:,:,:) = 0.3_wp * zqsr_ice(:,:,:) 2201 2203 ENDIF 2202 ! 2204 ! 2203 2205 ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==! 2204 2206 ! … … 2220 2222 ! ! ================== ! 2221 2223 ! needed by Met Office 2222 IF( srcv(jpr_ts_ice)%laction ) THEN 2223 WHERE ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0 ) ; ztsu(:,:,:) = 0. + rt0 2224 IF( srcv(jpr_ts_ice)%laction ) THEN 2225 WHERE ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0 ) ; ztsu(:,:,:) = 0. + rt0 2224 2226 ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. ) ; ztsu(:,:,:) = -60. + rt0 2225 2227 ELSEWHERE ; ztsu(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:) + rt0 … … 2239 2241 ! 2240 2242 END SUBROUTINE sbc_cpl_ice_flx 2241 2242 2243 2244 2243 2245 SUBROUTINE sbc_cpl_snd( kt, Kbb, Kmm ) 2244 2246 !!---------------------------------------------------------------------- … … 2257 2259 REAL(wp) :: zumax, zvmax 2258 2260 REAL(wp), DIMENSION(jpi,jpj) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 2259 REAL(wp), DIMENSION(jpi,jpj,jpl) :: ztmp3, ztmp4 2261 REAL(wp), DIMENSION(jpi,jpj,jpl) :: ztmp3, ztmp4 2260 2262 !!---------------------------------------------------------------------- 2261 2263 ! … … 2268 2270 ! ! ------------------------- ! 2269 2271 IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 2270 2272 2271 2273 IF( nn_components == jp_iam_opa ) THEN 2272 2274 ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 2273 2275 ELSE 2274 ! we must send the surface potential temperature 2276 ! we must send the surface potential temperature 2275 2277 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) ) 2276 2278 ELSE ; ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) … … 2281 2283 CASE( 'oce and ice' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0 2282 2284 SELECT CASE( sn_snd_temp%clcat ) 2283 CASE( 'yes' ) 2285 CASE( 'yes' ) 2284 2286 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) 2285 2287 CASE( 'no' ) … … 2291 2293 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 2292 2294 END SELECT 2293 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 2295 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 2294 2296 SELECT CASE( sn_snd_temp%clcat ) 2295 CASE( 'yes' ) 2297 CASE( 'yes' ) 2296 2298 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2297 2299 CASE( 'no' ) … … 2302 2304 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 2303 2305 END SELECT 2304 CASE( 'oce and weighted ice') ; ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) + rt0 2305 SELECT CASE( sn_snd_temp%clcat ) 2306 CASE( 'yes' ) 2307 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2308 CASE( 'no' ) 2309 ztmp3(:,:,:) = 0.0 2310 DO jl=1,jpl 2311 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 2312 ENDDO 2313 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 2314 END SELECT 2315 CASE( 'mixed oce-ice' ) 2316 ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 2306 CASE( 'oce and weighted ice') ; ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) + rt0 2307 SELECT CASE( sn_snd_temp%clcat ) 2308 CASE( 'yes' ) 2309 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2310 CASE( 'no' ) 2311 ztmp3(:,:,:) = 0.0 2312 DO jl=1,jpl 2313 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 2314 ENDDO 2315 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 2316 END SELECT 2317 CASE( 'mixed oce-ice' ) 2318 ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 2317 2319 DO jl=1,jpl 2318 2320 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) … … 2334 2336 SELECT CASE( sn_snd_ttilyr%cldes) 2335 2337 CASE ('weighted ice') 2336 ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2338 ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2337 2339 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ttilyr%cldes' ) 2338 2340 END SELECT … … 2343 2345 ! ! Albedo ! 2344 2346 ! ! ------------------------- ! 2345 IF( ssnd(jps_albice)%laction ) THEN ! ice 2347 IF( ssnd(jps_albice)%laction ) THEN ! ice 2346 2348 SELECT CASE( sn_snd_alb%cldes ) 2347 2349 CASE( 'ice' ) 2348 2350 SELECT CASE( sn_snd_alb%clcat ) 2349 CASE( 'yes' ) 2351 CASE( 'yes' ) 2350 2352 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 2351 2353 CASE( 'no' ) … … 2359 2361 CASE( 'weighted ice' ) ; 2360 2362 SELECT CASE( sn_snd_alb%clcat ) 2361 CASE( 'yes' ) 2363 CASE( 'yes' ) 2362 2364 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2363 2365 CASE( 'no' ) … … 2373 2375 2374 2376 SELECT CASE( sn_snd_alb%clcat ) 2375 CASE( 'yes' ) 2377 CASE( 'yes' ) 2376 2378 CALL cpl_snd( jps_albice, isec, ztmp3, info ) !-> MV this has never been checked in coupled mode 2377 CASE( 'no' ) 2378 CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2379 CASE( 'no' ) 2380 CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2379 2381 END SELECT 2380 2382 ENDIF … … 2388 2390 ENDIF 2389 2391 ! ! ------------------------- ! 2390 ! ! Ice fraction & Thickness ! 2392 ! ! Ice fraction & Thickness ! 2391 2393 ! ! ------------------------- ! 2392 2394 ! Send ice fraction field to atmosphere … … 2401 2403 2402 2404 #if defined key_si3 || defined key_cice 2403 ! If this coupling was successful then save ice fraction for use between coupling points. 2404 ! This is needed for some calculations where the ice fraction at the last coupling point 2405 ! is needed. 2406 IF( info == OASIS_Sent .OR. info == OASIS_ToRest .OR. & 2407 & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN 2408 IF ( sn_snd_thick%clcat == 'yes' ) THEN 2405 ! If this coupling was successful then save ice fraction for use between coupling points. 2406 ! This is needed for some calculations where the ice fraction at the last coupling point 2407 ! is needed. 2408 IF( info == OASIS_Sent .OR. info == OASIS_ToRest .OR. & 2409 & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN 2410 IF ( sn_snd_thick%clcat == 'yes' ) THEN 2409 2411 a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl) 2410 2412 ENDIF … … 2420 2422 CALL cpl_snd( jps_fice1, isec, ztmp3, info ) 2421 2423 ENDIF 2422 2424 2423 2425 ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling) 2424 2426 IF( ssnd(jps_fice2)%laction ) THEN … … 2427 2429 ENDIF 2428 2430 2429 ! Send ice and snow thickness field 2430 IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN 2431 ! Send ice and snow thickness field 2432 IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN 2431 2433 SELECT CASE( sn_snd_thick%cldes) 2432 2434 CASE( 'none' ) ! nothing to do 2433 CASE( 'weighted ice and snow' ) 2435 CASE( 'weighted ice and snow' ) 2434 2436 SELECT CASE( sn_snd_thick%clcat ) 2435 CASE( 'yes' ) 2437 CASE( 'yes' ) 2436 2438 ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl) * a_i(:,:,1:jpl) 2437 2439 ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl) * a_i(:,:,1:jpl) … … 2444 2446 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 2445 2447 END SELECT 2446 CASE( 'ice and snow' ) 2448 CASE( 'ice and snow' ) 2447 2449 SELECT CASE( sn_snd_thick%clcat ) 2448 2450 CASE( 'yes' ) … … 2467 2469 #if defined key_si3 2468 2470 ! ! ------------------------- ! 2469 ! ! Ice melt ponds ! 2470 ! ! ------------------------- ! 2471 ! needed by Met Office: 1) fraction of ponded ice 2) local/actual pond depth 2472 IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 2473 SELECT CASE( sn_snd_mpnd%cldes) 2474 CASE( 'ice only' ) 2475 SELECT CASE( sn_snd_mpnd%clcat ) 2476 CASE( 'yes' ) 2471 ! ! Ice melt ponds ! 2472 ! ! ------------------------- ! 2473 ! needed by Met Office: 1) fraction of ponded ice 2) local/actual pond depth 2474 IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 2475 SELECT CASE( sn_snd_mpnd%cldes) 2476 CASE( 'ice only' ) 2477 SELECT CASE( sn_snd_mpnd%clcat ) 2478 CASE( 'yes' ) 2477 2479 ztmp3(:,:,1:jpl) = a_ip_eff(:,:,1:jpl) 2478 ztmp4(:,:,1:jpl) = h_ip(:,:,1:jpl) 2479 CASE( 'no' ) 2480 ztmp3(:,:,:) = 0.0 2481 ztmp4(:,:,:) = 0.0 2482 DO jl=1,jpl 2480 ztmp4(:,:,1:jpl) = h_ip(:,:,1:jpl) 2481 CASE( 'no' ) 2482 ztmp3(:,:,:) = 0.0 2483 ztmp4(:,:,:) = 0.0 2484 DO jl=1,jpl 2483 2485 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 2484 2486 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 2485 ENDDO 2486 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' ) 2487 END SELECT 2488 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%cldes' ) 2489 END SELECT 2490 IF( ssnd(jps_a_p)%laction ) CALL cpl_snd( jps_a_p , isec, ztmp3, info ) 2491 IF( ssnd(jps_ht_p)%laction ) CALL cpl_snd( jps_ht_p, isec, ztmp4, info ) 2492 ENDIF 2493 ! 2494 ! ! ------------------------- ! 2495 ! ! Ice conductivity ! 2487 ENDDO 2488 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' ) 2489 END SELECT 2490 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%cldes' ) 2491 END SELECT 2492 IF( ssnd(jps_a_p)%laction ) CALL cpl_snd( jps_a_p , isec, ztmp3, info ) 2493 IF( ssnd(jps_ht_p)%laction ) CALL cpl_snd( jps_ht_p, isec, ztmp4, info ) 2494 ENDIF 2495 ! 2496 ! ! ------------------------- ! 2497 ! ! Ice conductivity ! 2496 2498 ! ! ------------------------- ! 2497 2499 ! needed by Met Office 2498 IF( ssnd(jps_kice)%laction ) THEN 2499 SELECT CASE( sn_snd_cond%cldes) 2500 CASE( 'weighted ice' ) 2501 SELECT CASE( sn_snd_cond%clcat ) 2502 CASE( 'yes' ) 2503 ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2504 CASE( 'no' ) 2505 ztmp3(:,:,:) = 0.0 2506 DO jl=1,jpl 2507 ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(:,:,jl) 2508 ENDDO 2509 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' ) 2510 END SELECT 2511 CASE( 'ice only' ) 2512 ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) 2513 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%cldes' ) 2514 END SELECT 2515 IF( ssnd(jps_kice)%laction ) CALL cpl_snd( jps_kice, isec, ztmp3, info ) 2516 ENDIF 2500 IF( ssnd(jps_kice)%laction ) THEN 2501 SELECT CASE( sn_snd_cond%cldes) 2502 CASE( 'weighted ice' ) 2503 SELECT CASE( sn_snd_cond%clcat ) 2504 CASE( 'yes' ) 2505 ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2506 CASE( 'no' ) 2507 ztmp3(:,:,:) = 0.0 2508 DO jl=1,jpl 2509 ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(:,:,jl) 2510 ENDDO 2511 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' ) 2512 END SELECT 2513 CASE( 'ice only' ) 2514 ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) 2515 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%cldes' ) 2516 END SELECT 2517 IF( ssnd(jps_kice)%laction ) CALL cpl_snd( jps_kice, isec, ztmp3, info ) 2518 ENDIF 2517 2519 #endif 2518 2520 2519 2521 ! ! ------------------------- ! 2520 ! ! CO2 flux from PISCES ! 2521 ! ! ------------------------- ! 2522 IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) THEN 2522 ! ! CO2 flux from PISCES ! 2523 ! ! ------------------------- ! 2524 IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) THEN 2523 2525 ztmp1(:,:) = oce_co2(:,:) * 1000. ! conversion in molC/m2/s 2524 2526 CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ) , info ) … … 2528 2530 IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current ! 2529 2531 ! ! ------------------------- ! 2530 ! 2532 ! 2531 2533 ! j+1 j -----V---F 2532 2534 ! surface velocity always sent from T point ! | … … 2538 2540 ! i i+1 (for I) 2539 2541 IF( nn_components == jp_iam_opa ) THEN 2540 zotx1(:,:) = uu(:,:,1,Kmm) 2541 zoty1(:,:) = vv(:,:,1,Kmm) 2542 ELSE 2542 zotx1(:,:) = uu(:,:,1,Kmm) 2543 zoty1(:,:) = vv(:,:,1,Kmm) 2544 ELSE 2543 2545 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 2544 2546 CASE( 'oce only' ) ! C-grid ==> T 2545 2547 DO_2D( 0, 0, 0, 0 ) 2546 2548 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) 2547 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji ,jj-1,1,Kmm) ) 2549 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji ,jj-1,1,Kmm) ) 2548 2550 END_2D 2549 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2551 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2550 2552 DO_2D( 0, 0, 0, 0 ) 2551 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2553 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2552 2554 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 2553 2555 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) … … 2570 2572 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 2571 2573 ! ! Ocean component 2572 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2573 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2574 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2574 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2575 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2576 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2575 2577 zoty1(:,:) = ztmp2(:,:) 2576 2578 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2577 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2578 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2579 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2579 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2580 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2581 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2580 2582 zity1(:,:) = ztmp2(:,:) 2581 2583 ENDIF … … 2602 2604 IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid 2603 2605 IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid 2604 ! 2605 ENDIF 2606 ! 2607 ! ! ------------------------- ! 2608 ! ! Surface current to waves ! 2609 ! ! ------------------------- ! 2610 IF( ssnd(jps_ocxw)%laction .OR. ssnd(jps_ocyw)%laction ) THEN 2611 ! 2612 ! j+1 j -----V---F 2613 ! surface velocity always sent from T point ! | 2614 ! j | T U 2615 ! | | 2616 ! j j-1 -I-------| 2617 ! (for I) | | 2618 ! i-1 i i 2619 ! i i+1 (for I) 2620 SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 2621 CASE( 'oce only' ) ! C-grid ==> T 2606 ! 2607 ENDIF 2608 ! 2609 ! ! ------------------------- ! 2610 ! ! Surface current to waves ! 2611 ! ! ------------------------- ! 2612 IF( ssnd(jps_ocxw)%laction .OR. ssnd(jps_ocyw)%laction ) THEN 2613 ! 2614 ! j+1 j -----V---F 2615 ! surface velocity always sent from T point ! | 2616 ! j | T U 2617 ! | | 2618 ! j j-1 -I-------| 2619 ! (for I) | | 2620 ! i-1 i i 2621 ! i i+1 (for I) 2622 SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 2623 CASE( 'oce only' ) ! C-grid ==> T 2622 2624 DO_2D( 0, 0, 0, 0 ) 2623 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) 2624 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) ) 2625 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) 2626 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) ) 2625 2627 END_2D 2626 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2628 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2627 2629 DO_2D( 0, 0, 0, 0 ) 2628 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2629 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 2630 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2631 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2630 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2631 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 2632 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2633 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2632 2634 END_2D 2633 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2634 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2635 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2636 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2635 2637 DO_2D( 0, 0, 0, 0 ) 2636 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & 2637 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2638 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) & 2639 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2638 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & 2639 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2640 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) & 2641 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2640 2642 END_2D 2641 2643 END SELECT 2642 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp ) 2643 ! 2644 ! 2645 IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 2646 ! ! Ocean component 2647 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2648 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2649 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2650 zoty1(:,:) = ztmp2(:,:) 2651 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2652 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2653 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2654 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2655 zity1(:,:) = ztmp2(:,:) 2656 ENDIF 2657 ENDIF 2658 ! 2659 ! ! spherical coordinates to cartesian -> 2 components to 3 components 2660 ! IF( TRIM( sn_snd_crtw%clvref ) == 'cartesian' ) THEN 2661 ! ztmp1(:,:) = zotx1(:,:) ! ocean currents 2662 ! ztmp2(:,:) = zoty1(:,:) 2663 ! CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 ) 2664 ! ! 2665 ! IF( ssnd(jps_ivx1)%laction ) THEN ! ice velocities 2666 ! ztmp1(:,:) = zitx1(:,:) 2667 ! ztmp1(:,:) = zity1(:,:) 2668 ! CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 ) 2669 ! ENDIF 2670 ! ENDIF 2671 ! 2672 IF( ssnd(jps_ocxw)%laction ) CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid 2673 IF( ssnd(jps_ocyw)%laction ) CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid 2674 ! 2675 ENDIF 2676 ! 2677 IF( ssnd(jps_ficet)%laction ) THEN 2678 CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info ) 2679 ENDIF 2680 ! ! ------------------------- ! 2681 ! ! Water levels to waves ! 2682 ! ! ------------------------- ! 2683 IF( ssnd(jps_wlev)%laction ) THEN 2684 IF( ln_apr_dyn ) THEN 2685 IF( kt /= nit000 ) THEN 2686 ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 2687 ELSE 2688 ztmp1(:,:) = ssh(:,:,Kbb) 2689 ENDIF 2690 ELSE 2691 ztmp1(:,:) = ssh(:,:,Kmm) 2692 ENDIF 2693 CALL cpl_snd( jps_wlev , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2694 ENDIF 2644 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp ) 2645 ! 2646 ! 2647 IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 2648 ! ! Ocean component 2649 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2650 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2651 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2652 zoty1(:,:) = ztmp2(:,:) 2653 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2654 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2655 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2656 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2657 zity1(:,:) = ztmp2(:,:) 2658 ENDIF 2659 ENDIF 2660 ! 2661 ! ! spherical coordinates to cartesian -> 2 components to 3 components 2662 ! IF( TRIM( sn_snd_crtw%clvref ) == 'cartesian' ) THEN 2663 ! ztmp1(:,:) = zotx1(:,:) ! ocean currents 2664 ! ztmp2(:,:) = zoty1(:,:) 2665 ! CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 ) 2666 ! ! 2667 ! IF( ssnd(jps_ivx1)%laction ) THEN ! ice velocities 2668 ! ztmp1(:,:) = zitx1(:,:) 2669 ! ztmp1(:,:) = zity1(:,:) 2670 ! CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 ) 2671 ! ENDIF 2672 ! ENDIF 2673 ! 2674 IF( ssnd(jps_ocxw)%laction ) CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid 2675 IF( ssnd(jps_ocyw)%laction ) CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid 2676 ! 2677 ENDIF 2678 ! 2679 IF( ssnd(jps_ficet)%laction ) THEN 2680 CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info ) 2681 ENDIF 2682 ! ! ------------------------- ! 2683 ! ! Water levels to waves ! 2684 ! ! ------------------------- ! 2685 IF( ssnd(jps_wlev)%laction ) THEN 2686 IF( ln_apr_dyn ) THEN 2687 IF( kt /= nit000 ) THEN 2688 ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 2689 ELSE 2690 ztmp1(:,:) = ssh(:,:,Kbb) 2691 ENDIF 2692 ELSE 2693 ztmp1(:,:) = ssh(:,:,Kmm) 2694 ENDIF 2695 CALL cpl_snd( jps_wlev , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2696 ENDIF 2695 2697 ! 2696 2698 ! Fields sent by OPA to SAS when doing OPA<->SAS coupling … … 2709 2711 CALL cpl_snd( jps_soce , isec, RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) ), info ) 2710 2712 ENDIF 2711 ! ! first T level thickness 2713 ! ! first T level thickness 2712 2714 IF( ssnd(jps_e3t1st )%laction ) THEN 2713 2715 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(:,:,1,Kmm) , (/jpi,jpj,1/) ), info ) … … 2731 2733 #if defined key_si3 2732 2734 ! ! ------------------------- ! 2733 ! ! Sea surface freezing temp ! 2735 ! ! Sea surface freezing temp ! 2734 2736 ! ! ------------------------- ! 2735 2737 ! needed by Met Office … … 2740 2742 ! 2741 2743 END SUBROUTINE sbc_cpl_snd 2742 2744 2743 2745 !!====================================================================== 2744 2746 END MODULE sbccpl
Note: See TracChangeset
for help on using the changeset viewer.
