- Timestamp:
- 2014-10-31T12:45:41+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r3680 r4827 26 26 USE sbcdcy ! surface boundary condition: diurnal cycle 27 27 USE phycst ! physical constants 28 USE fldread2, ONLY: fld_fill2 ! read input fields 29 USE fld_def 30 USE sbcget 28 31 #if defined key_lim3 29 32 USE par_ice ! ice parameters … … 53 56 #endif 54 57 USE diaar5, ONLY : lk_diaar5 55 #if defined key_cice 56 USE ice_domain_size, only: ncat 57 #endif 58 58 59 IMPLICIT NONE 59 60 PRIVATE … … 63 64 PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim(_2).F90 64 65 PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim(_2).F90 65 66 INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 167 INTEGER, PARAMETER :: jpr_oty1 = 2 !68 INTEGER, PARAMETER :: jpr_otz1 = 3 !69 INTEGER, PARAMETER :: jpr_otx2 = 4 ! 3 atmosphere-ocean stress components on grid 270 INTEGER, PARAMETER :: jpr_oty2 = 5 !71 INTEGER, PARAMETER :: jpr_otz2 = 6 !72 INTEGER, PARAMETER :: jpr_itx1 = 7 ! 3 atmosphere-ice stress components on grid 173 INTEGER, PARAMETER :: jpr_ity1 = 8 !74 INTEGER, PARAMETER :: jpr_itz1 = 9 !75 INTEGER, PARAMETER :: jpr_itx2 = 10 ! 3 atmosphere-ice stress components on grid 276 INTEGER, PARAMETER :: jpr_ity2 = 11 !77 INTEGER, PARAMETER :: jpr_itz2 = 12 !78 INTEGER, PARAMETER :: jpr_qsroce = 13 ! Qsr above the ocean79 INTEGER, PARAMETER :: jpr_qsrice = 14 ! Qsr above the ice80 INTEGER, PARAMETER :: jpr_qsrmix = 1581 INTEGER, PARAMETER :: jpr_qnsoce = 16 ! Qns above the ocean82 INTEGER, PARAMETER :: jpr_qnsice = 17 ! Qns above the ice83 INTEGER, PARAMETER :: jpr_qnsmix = 1884 INTEGER, PARAMETER :: jpr_rain = 19 ! total liquid precipitation (rain)85 INTEGER, PARAMETER :: jpr_snow = 20 ! solid precipitation over the ocean (snow)86 INTEGER, PARAMETER :: jpr_tevp = 21 ! total evaporation87 INTEGER, PARAMETER :: jpr_ievp = 22 ! solid evaporation (sublimation)88 INTEGER, PARAMETER :: jpr_sbpr = 23 ! sublimation - liquid precipitation - solid precipitation89 INTEGER, PARAMETER :: jpr_semp = 24 ! solid freshwater budget (sublimation - snow)90 INTEGER, PARAMETER :: jpr_oemp = 25 ! ocean freshwater budget (evap - precip)91 INTEGER, PARAMETER :: jpr_w10m = 26 ! 10m wind92 INTEGER, PARAMETER :: jpr_dqnsdt = 27 ! d(Q non solar)/d(temperature)93 INTEGER, PARAMETER :: jpr_rnf = 28 ! runoffs94 INTEGER, PARAMETER :: jpr_cal = 29 ! calving95 INTEGER, PARAMETER :: jpr_taum = 30 ! wind stress module96 INTEGER, PARAMETER :: jpr_co2 = 3197 INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn98 INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn99 INTEGER, PARAMETER :: jprcv = 33 ! total number of fields received100 66 101 67 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction … … 124 90 CHARACTER(len = 32) :: clvgrd ! grids on which is located the vector fields 125 91 END TYPE FLD_C 92 93 126 94 ! Send to the atmosphere ! 127 95 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 … … 129 97 TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 130 98 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 131 132 TYPE :: DYNARR 133 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 134 END TYPE DYNARR 135 136 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere 99 TYPE(FLD_N) :: sn_wndi, sn_wndj, sn_otx1, sn_oty1, sn_otz1, sn_otx2, sn_oty2, sn_otz2, sn_itx1, sn_ity1, sn_itz1, sn_itx2, sn_ity2, sn_itz2 137 100 138 101 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 139 140 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument141 102 142 103 #if ! defined key_lim2 && ! defined key_lim3 … … 145 106 #endif 146 107 147 #if defined key_cice 148 INTEGER, PARAMETER :: jpl = ncat 149 #elif ! defined key_lim2 && ! defined key_lim3 150 INTEGER, PARAMETER :: jpl = 1 108 #if ! defined key_cice && ! defined key_lim2 && ! defined key_lim3 151 109 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice 152 110 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice … … 183 141 ierr(:) = 0 184 142 ! 185 ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv),STAT=ierr(1) )143 ALLOCATE( albedo_oce_mix(jpi,jpj), STAT=ierr(1) ) 186 144 ! 187 145 #if ! defined key_lim2 && ! defined key_lim3 … … 220 178 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 221 179 !! 222 INTEGER :: jn ! dummy loop index180 INTEGER :: jn ! dummy loop index 223 181 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 224 182 !! … … 297 255 ! Define the receive interface ! 298 256 ! ================================ ! 299 nrcvinfo(:) = OASIS_idle ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress 300 301 ! for each field: define the OASIS name (srcv(:)%clname) 302 ! define receive or not from the namelist parameters (srcv(:)%laction) 303 ! define the north fold type of lbc (srcv(:)%nsgn) 304 305 ! default definitions of srcv 306 srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1 307 308 ! ! ------------------------- ! 309 ! ! ice and ocean wind stress ! 310 ! ! ------------------------- ! 311 ! ! Name 312 srcv(jpr_otx1)%clname = 'O_OTaux1' ! 1st ocean component on grid ONE (T or U) 313 srcv(jpr_oty1)%clname = 'O_OTauy1' ! 2nd - - - - 314 srcv(jpr_otz1)%clname = 'O_OTauz1' ! 3rd - - - - 315 srcv(jpr_otx2)%clname = 'O_OTaux2' ! 1st ocean component on grid TWO (V) 316 srcv(jpr_oty2)%clname = 'O_OTauy2' ! 2nd - - - - 317 srcv(jpr_otz2)%clname = 'O_OTauz2' ! 3rd - - - - 318 ! 319 srcv(jpr_itx1)%clname = 'O_ITaux1' ! 1st ice component on grid ONE (T, F, I or U) 320 srcv(jpr_ity1)%clname = 'O_ITauy1' ! 2nd - - - - 321 srcv(jpr_itz1)%clname = 'O_ITauz1' ! 3rd - - - - 322 srcv(jpr_itx2)%clname = 'O_ITaux2' ! 1st ice component on grid TWO (V) 323 srcv(jpr_ity2)%clname = 'O_ITauy2' ! 2nd - - - - 324 srcv(jpr_itz2)%clname = 'O_ITauz2' ! 3rd - - - - 325 ! 257 326 258 ! Vectors: change of sign at north fold ONLY if on the local grid 327 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) s rcv(jpr_otx1:jpr_itz2)%nsgn = -1.259 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) sf(jp_otx1:jp_itz2)%nsgn = -1. 328 260 329 ! ! Set grid and action330 SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) ) ! 'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V'331 CASE( 'T' )332 srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point333 srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1334 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1335 CASE( 'U,V' )336 srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point337 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point338 srcv(jpr_itx1:jpr_itz1)%clgrid = 'U' ! ice components given at U-point339 srcv(jpr_itx2:jpr_itz2)%clgrid = 'V' ! and V-point340 srcv(jpr_otx1:jpr_itz2)%laction = .TRUE. ! receive oce and ice components on both grid 1 & 2341 CASE( 'U,V,T' )342 srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point343 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point344 srcv(jpr_itx1:jpr_itz1)%clgrid = 'T' ! ice components given at T-point345 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2346 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only347 CASE( 'U,V,I' )348 srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point349 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point350 srcv(jpr_itx1:jpr_itz1)%clgrid = 'I' ! ice components given at I-point351 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2352 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only353 CASE( 'U,V,F' )354 srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point355 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point356 srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point357 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2358 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only359 CASE( 'T,I' )360 srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point361 srcv(jpr_itx1:jpr_itz1)%clgrid = 'I' ! ice components given at I-point362 srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1363 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1364 CASE( 'T,F' )365 srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point366 srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point367 srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1368 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1369 CASE( 'T,U,V' )370 srcv(jpr_otx1:jpr_otz1)%clgrid = 'T' ! oce components given at T-point371 srcv(jpr_itx1:jpr_itz1)%clgrid = 'U' ! ice components given at U-point372 srcv(jpr_itx2:jpr_itz2)%clgrid = 'V' ! and V-point373 srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1 only374 srcv(jpr_itx1:jpr_itz2)%laction = .TRUE. ! receive ice components on grid 1 & 2375 CASE default376 CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' )377 END SELECT378 !379 IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' ) & ! spherical: 3rd component not received380 & srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE.381 261 ! 382 262 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) THEN ! already on local grid -> no need of the second grid 383 srcv(jpr_otx2:jpr_otz2)%laction = .FALSE. 384 srcv(jpr_itx2:jpr_itz2)%laction = .FALSE. 385 srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid ! not needed but cleaner... 386 srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid ! not needed but cleaner... 387 ENDIF 388 ! 389 IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used 390 srcv(jpr_itx1:jpr_itz2)%laction = .FALSE. ! ice components not received 391 srcv(jpr_itx1)%clgrid = 'U' ! ocean stress used after its transformation 392 srcv(jpr_ity1)%clgrid = 'V' ! i.e. it is always at U- & V-points for i- & j-comp. resp. 393 ENDIF 394 395 ! ! ------------------------- ! 396 ! ! freshwater budget ! E-P 397 ! ! ------------------------- ! 398 ! we suppose that atmosphere modele do not make the difference between precipiration (liquide or solid) 399 ! over ice of free ocean within the same atmospheric cell.cd 400 srcv(jpr_rain)%clname = 'OTotRain' ! Rain = liquid precipitation 401 srcv(jpr_snow)%clname = 'OTotSnow' ! Snow = solid precipitation 402 srcv(jpr_tevp)%clname = 'OTotEvap' ! total evaporation (over oce + ice sublimation) 403 srcv(jpr_ievp)%clname = 'OIceEvap' ! evaporation over ice = sublimation 404 srcv(jpr_sbpr)%clname = 'OSubMPre' ! sublimation - liquid precipitation - solid precipitation 405 srcv(jpr_semp)%clname = 'OISubMSn' ! ice solid water budget = sublimation - solid precipitation 406 srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip 407 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 408 CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE. 409 CASE( 'conservative' ) ; srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 410 CASE( 'oce and ice' ) ; srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE. 411 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 412 END SELECT 413 414 ! ! ------------------------- ! 415 ! ! Runoffs & Calving ! 416 ! ! ------------------------- ! 417 srcv(jpr_rnf )%clname = 'O_Runoff' ; IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 418 ! This isn't right - really just want ln_rnf_emp changed 419 ! IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' ) THEN ; ln_rnf = .TRUE. 420 ! ELSE ; ln_rnf = .FALSE. 421 ! ENDIF 422 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 423 424 ! ! ------------------------- ! 425 ! ! non solar radiation ! Qns 426 ! ! ------------------------- ! 427 srcv(jpr_qnsoce)%clname = 'O_QnsOce' 428 srcv(jpr_qnsice)%clname = 'O_QnsIce' 429 srcv(jpr_qnsmix)%clname = 'O_QnsMix' 430 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 431 CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE. 432 CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. 433 CASE( 'oce and ice' ) ; srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE. 434 CASE( 'mixed oce-ice' ) ; srcv( jpr_qnsmix )%laction = .TRUE. 435 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' ) 436 END SELECT 437 IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 438 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 439 ! ! ------------------------- ! 440 ! ! solar radiation ! Qsr 441 ! ! ------------------------- ! 442 srcv(jpr_qsroce)%clname = 'O_QsrOce' 443 srcv(jpr_qsrice)%clname = 'O_QsrIce' 444 srcv(jpr_qsrmix)%clname = 'O_QsrMix' 445 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 446 CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE. 447 CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. 448 CASE( 'oce and ice' ) ; srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE. 449 CASE( 'mixed oce-ice' ) ; srcv( jpr_qsrmix )%laction = .TRUE. 450 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' ) 451 END SELECT 452 IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 453 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 454 ! ! ------------------------- ! 455 ! ! non solar sensitivity ! d(Qns)/d(T) 456 ! ! ------------------------- ! 457 srcv(jpr_dqnsdt)%clname = 'O_dQnsdT' 458 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' ) srcv(jpr_dqnsdt)%laction = .TRUE. 459 ! 460 ! non solar sensitivity mandatory for LIM ice model 461 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) & 462 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 463 ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique 464 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) & 465 CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' ) 466 ! ! ------------------------- ! 467 ! ! Ice Qsr penetration ! 468 ! ! ------------------------- ! 469 ! fraction of net shortwave radiation which is not absorbed in the thin surface layer 470 ! and penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 471 ! Coupled case: since cloud cover is not received from atmosphere 472 ! ===> defined as constant value -> definition done in sbc_cpl_init 473 fr1_i0(:,:) = 0.18 474 fr2_i0(:,:) = 0.82 475 ! ! ------------------------- ! 476 ! ! 10m wind module ! 477 ! ! ------------------------- ! 478 srcv(jpr_w10m)%clname = 'O_Wind10' ; IF( TRIM(sn_rcv_w10m%cldes ) == 'coupled' ) srcv(jpr_w10m)%laction = .TRUE. 479 ! 480 ! ! ------------------------- ! 481 ! ! wind stress module ! 482 ! ! ------------------------- ! 483 srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE. 484 lhftau = srcv(jpr_taum)%laction 485 486 ! ! ------------------------- ! 487 ! ! Atmospheric CO2 ! 488 ! ! ------------------------- ! 489 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 490 ! ! ------------------------- ! 491 ! ! topmelt and botmelt ! 492 ! ! ------------------------- ! 493 srcv(jpr_topm )%clname = 'OTopMlt' 494 srcv(jpr_botm )%clname = 'OBotMlt' 495 IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 496 IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 497 srcv(jpr_topm:jpr_botm)%nct = jpl 498 ELSE 499 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' ) 500 ENDIF 501 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 502 ENDIF 503 504 ! Allocate all parts of frcv used for received fields 505 DO jn = 1, jprcv 506 IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 507 END DO 508 ! Allocate taum part of frcv which is used even when not received as coupling field 509 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jn)%nct) ) 263 sf(jp_oty1)%clvgrd = sf(jp_oty2)%clvgrd ! not needed but cleaner... 264 sf(jp_ity1)%clvgrd = sf(jp_ity2)%clvgrd ! not needed but cleaner... 265 ENDIF 266 ! 510 267 511 268 ! ================================ ! … … 621 378 ! ================================ ! 622 379 623 CALL cpl_prism_define(jp rcv, jpsnd)624 ! 625 IF( ln_dm2dc .AND. ( cpl_prism_freq( jp r_qsroce ) + cpl_prism_freq( jpr_qsrmix ) /= 86400 ) ) &380 CALL cpl_prism_define(jpfld, jpsnd, sf) 381 ! 382 IF( ln_dm2dc .AND. ( cpl_prism_freq( jp_qsroce ) + cpl_prism_freq( jp_qsrmix ) /= 86400 ) ) & 626 383 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 627 384 … … 640 397 !! provide the ocean heat and freshwater fluxes. 641 398 !! 642 !! ** Method : - Receive all the atmospheric fields (stored in frcvarray). called at each time step.643 !! OASIS controls if there is something do receive or not. n rcvinfo contains the info399 !! ** Method : - Receive all the atmospheric fields (stored in sf array). called at each time step. 400 !! OASIS controls if there is something do receive or not. ninfo contains the info 644 401 !! to know if the field was really received or not 645 402 !! … … 683 440 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 684 441 INTEGER :: ji, jj, jn ! dummy loop indices 685 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000)686 442 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 687 443 REAL(wp) :: zcoef ! temporary scalar … … 699 455 700 456 ! ! Receive all the atmos. fields (including ice information) 701 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges702 DO jn = 1, jprcv ! received fields sent by the atmosphere703 IF( srcv(jn)%laction ) CALL cpl_prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) )704 END DO705 706 457 ! ! ========================= ! 707 IF( s rcv(jpr_otx1)%laction) THEN ! ocean stress components !458 IF( sf(jp_otx1)%loasis ) THEN ! ocean stress components ! 708 459 ! ! ========================= ! 709 ! define frcv(jpr_otx1)%z3(:,:,1) and frcv(jpr_oty1)%z3(:,:,1): stress at U/V point along model grid460 ! define sf(jp_otx1)%fnow(:,:,1) and sf(jp_oty1)%fnow(:,:,1): stress at U/V point along model grid 710 461 ! => need to be done only when we receive the field 711 IF( nrcvinfo(jpr_otx1)== OASIS_Rcv ) THEN462 IF( sf(jp_otx1)%ninfo == OASIS_Rcv ) THEN 712 463 ! 713 464 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere 714 465 ! ! (cartesian to spherical -> 3 to 2 components) 715 466 ! 716 CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1), &717 & s rcv(jpr_otx1)%clgrid, ztx, zty )718 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid719 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid467 CALL geo2oce( sf(jp_otx1)%fnow(:,:,1), sf(jp_oty1)%fnow(:,:,1), sf(jp_otz1)%fnow(:,:,1), & 468 & sf(jp_otx1)%clvgrd, ztx, zty ) 469 sf(jp_otx1)%fnow(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid 470 sf(jp_oty1)%fnow(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid 720 471 ! 721 IF( s rcv(jpr_otx2)%laction) THEN722 CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1), &723 & s rcv(jpr_otx2)%clgrid, ztx, zty )724 frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid725 frcv(jpr_oty2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid472 IF( sf(jp_otx2)%loasis ) THEN 473 CALL geo2oce( sf(jp_otx2)%fnow(:,:,1), sf(jp_oty2)%fnow(:,:,1), sf(jp_otz2)%fnow(:,:,1), & 474 & sf(jp_otx2)%clvgrd, ztx, zty ) 475 sf(jp_otx2)%fnow(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid 476 sf(jp_oty2)%fnow(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid 726 477 ENDIF 727 478 ! … … 730 481 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 731 482 ! ! (geographical to local grid -> rotate the components) 732 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )733 IF( s rcv(jpr_otx2)%laction) THEN734 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )483 CALL rot_rep( sf(jp_otx1)%fnow(:,:,1), sf(jp_oty1)%fnow(:,:,1), sf(jp_otx1)%clvgrd, 'en->i', ztx ) 484 IF( sf(jp_otx2)%loasis ) THEN 485 CALL rot_rep( sf(jp_otx2)%fnow(:,:,1), sf(jp_oty2)%fnow(:,:,1), sf(jp_otx2)%clvgrd, 'en->j', zty ) 735 486 ELSE 736 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )487 CALL rot_rep( sf(jp_otx1)%fnow(:,:,1), sf(jp_oty1)%fnow(:,:,1), sf(jp_otx1)%clvgrd, 'en->j', zty ) 737 488 ENDIF 738 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid739 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid489 sf(jp_otx1)%fnow(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 490 sf(jp_oty1)%fnow(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 740 491 ENDIF 741 492 ! 742 IF( s rcv(jpr_otx1)%clgrid == 'T' ) THEN493 IF( sf(jp_otx1)%clvgrd == 'T' ) THEN 743 494 DO jj = 2, jpjm1 ! T ==> (U,V) 744 495 DO ji = fs_2, fs_jpim1 ! vector opt. 745 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) )746 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) )747 END DO 748 END DO 749 CALL lbc_lnk( frcv(jpr_otx1)%z3(:,:,1), 'U', -1. ) ; CALL lbc_lnk( frcv(jpr_oty1)%z3(:,:,1), 'V', -1. )496 sf(jp_otx1)%fnow(ji,jj,1) = 0.5 * ( sf(jp_otx1)%fnow(ji+1,jj ,1) + sf(jp_otx1)%fnow(ji,jj,1) ) 497 sf(jp_oty1)%fnow(ji,jj,1) = 0.5 * ( sf(jp_oty1)%fnow(ji ,jj+1,1) + sf(jp_oty1)%fnow(ji,jj,1) ) 498 END DO 499 END DO 500 CALL lbc_lnk( sf(jp_otx1)%fnow(:,:,1), 'U', -1. ) ; CALL lbc_lnk( sf(jp_oty1)%fnow(:,:,1), 'V', -1. ) 750 501 ENDIF 751 502 llnewtx = .TRUE. … … 756 507 ELSE ! No dynamical coupling ! 757 508 ! ! ========================= ! 758 frcv(jpr_otx1)%z3(:,:,1) = 0.e0 ! here simply set to zero759 frcv(jpr_oty1)%z3(:,:,1) = 0.e0 ! an external read in a file can be added instead509 sf(jp_otx1)%fnow(:,:,1) = 0.e0 ! here simply set to zero 510 sf(jp_oty1)%fnow(:,:,1) = 0.e0 ! an external read in a file can be added instead 760 511 llnewtx = .TRUE. 761 512 ! … … 766 517 ! ! ========================= ! 767 518 ! 768 IF( .NOT. s rcv(jpr_taum)%laction) THEN ! compute wind stress module from its components if not received519 IF( .NOT. sf(jp_taum)%loasis ) THEN ! compute wind stress module from its components if not received 769 520 ! => need to be done only when otx1 was changed 770 521 IF( llnewtx ) THEN … … 773 524 !CDIR NOVERRCHK 774 525 DO ji = fs_2, fs_jpim1 ! vect. opt. 775 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1)776 zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)777 frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )526 zzx = sf(jp_otx1)%fnow(ji-1,jj ,1) + sf(jp_otx1)%fnow(ji,jj,1) 527 zzy = sf(jp_oty1)%fnow(ji ,jj-1,1) + sf(jp_oty1)%fnow(ji,jj,1) 528 sf(jp_taum)%fnow(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 778 529 END DO 779 530 END DO 780 CALL lbc_lnk( frcv(jpr_taum)%z3(:,:,1), 'T', 1. )531 CALL lbc_lnk( sf(jp_taum)%fnow(:,:,1), 'T', 1. ) 781 532 llnewtau = .TRUE. 782 533 ELSE … … 784 535 ENDIF 785 536 ELSE 786 llnewtau = nrcvinfo(jpr_taum)== OASIS_Rcv537 llnewtau = sf(jp_taum)%ninfo == OASIS_Rcv 787 538 ! Stress module can be negative when received (interpolation problem) 788 539 IF( llnewtau ) THEN 789 frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) )540 sf(jp_taum)%fnow(:,:,1) = MAX( 0._wp, sf(jp_taum)%fnow(:,:,1) ) 790 541 ENDIF 791 542 ENDIF … … 795 546 ! ! ========================= ! 796 547 ! 797 IF( .NOT. s rcv(jpr_w10m)%laction) THEN ! compute wind spreed from wind stress module if not received548 IF( .NOT. sf(jp_w10m)%loasis ) THEN ! compute wind spreed from wind stress module if not received 798 549 ! => need to be done only when taumod was changed 799 550 IF( llnewtau ) THEN … … 803 554 !CDIR NOVERRCHK 804 555 DO ji = 1, jpi 805 wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )556 wndm(ji,jj) = SQRT( sf(jp_taum)%fnow(ji,jj,1) * zcoef ) 806 557 END DO 807 558 END DO 808 559 ENDIF 809 560 ELSE 810 IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)561 IF ( sf(jp_w10m)%ninfo == OASIS_Rcv ) wndm(:,:) = sf(jp_w10m)%fnow(:,:,1) 811 562 ENDIF 812 563 … … 815 566 IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 816 567 ! 817 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)818 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)819 taum(:,:) = frcv(jpr_taum)%z3(:,:,1)568 utau(:,:) = sf(jp_otx1)%fnow(:,:,1) 569 vtau(:,:) = sf(jp_oty1)%fnow(:,:,1) 570 taum(:,:) = sf(jp_taum)%fnow(:,:,1) 820 571 CALL iom_put( "taum_oce", taum ) ! output wind stress module 821 572 ! … … 824 575 #if defined key_cpl_carbon_cycle 825 576 ! ! atmosph. CO2 (ppm) 826 IF( s rcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1)577 IF( sf(jp_co2)%loasis ) atm_co2(:,:) = sf(jp_co2)%fnow(:,:,1) 827 578 #endif 828 579 … … 834 585 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 835 586 CASE( 'conservative' ) 836 emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )587 emp(:,:) = sf(jp_tevp)%fnow(:,:,1) - ( sf(jp_rain)%fnow(:,:,1) + sf(jp_snow)%fnow(:,:,1) ) 837 588 CASE( 'oce only', 'oce and ice' ) 838 emp(:,:) = frcv(jpr_oemp)%z3(:,:,1)589 emp(:,:) = sf(jp_oemp)%fnow(:,:,1) 839 590 CASE default 840 591 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) … … 842 593 ! 843 594 ! ! runoffs and calving (added in emp) 844 IF( s rcv(jpr_rnf)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1)845 IF( s rcv(jpr_cal)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1)595 IF( sf(jp_rnf)%loasis ) emp(:,:) = emp(:,:) - sf(jp_rnf)%fnow(:,:,1) 596 IF( sf(jp_cal)%loasis ) emp(:,:) = emp(:,:) - sf(jp_cal)%fnow(:,:,1) 846 597 ! 847 598 !!gm : this seems to be internal cooking, not sure to need that in a generic interface … … 849 600 !! IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN ! add to the total freshwater budget 850 601 !! ! remove negative runoff 851 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )852 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )602 !! zcumulpos = SUM( MAX( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 603 !! zcumulneg = SUM( MIN( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 853 604 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) ! sum over the global domain 854 605 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 855 606 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 856 607 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 857 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg608 !! sf(jp_rnf)%fnow(:,:,1) = MAX( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * zcumulneg 858 609 !! ENDIF 859 610 !! ! add runoff to e-p 860 !! emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1)611 !! emp(:,:) = emp(:,:) - sf(jp_rnf)%fnow(:,:,1) 861 612 !! ENDIF 862 613 !!gm end of internal cooking 863 614 ! 864 615 ! ! non solar heat flux over the ocean (qns) 865 IF( s rcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)866 IF( s rcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)616 IF( sf(jp_qnsoce)%loasis ) qns(:,:) = sf(jp_qnsoce)%fnow(:,:,1) 617 IF( sf(jp_qnsmix)%loasis ) qns(:,:) = sf(jp_qnsmix)%fnow(:,:,1) 867 618 ! add the latent heat of solid precip. melting 868 IF( s rcv(jpr_snow )%laction) THEN ! update qns over the free ocean with:869 qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus & ! energy for melting solid precipitation over the free ocean619 IF( sf(jp_snow )%loasis ) THEN ! update qns over the free ocean with: 620 qns(:,:) = qns(:,:) - sf(jp_snow)%fnow(:,:,1) * lfus & ! energy for melting solid precipitation over the free ocean 870 621 & - emp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 871 622 ENDIF 872 623 873 624 ! ! solar flux over the ocean (qsr) 874 IF( s rcv(jpr_qsroce)%laction ) qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)875 IF( s rcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)625 IF( sf(jp_qsroce)%loasis ) qsr(:,:) = sf(jp_qsroce)%fnow(:,:,1) 626 IF( sf(jp_qsrmix)%loasis ) qsr(:,:) = sf(jp_qsrmix)%fnow(:,:,1) 876 627 IF( ln_dm2dc ) qsr(:,:) = sbc_dcy( qsr ) ! modify qsr to include the diurnal cycle 877 628 ! … … 931 682 CALL wrk_alloc( jpi,jpj, ztx, zty ) 932 683 933 IF( s rcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1934 ELSE ; itx = jp r_otx1684 IF( sf(jp_itx1)%loasis ) THEN ; itx = jp_itx1 685 ELSE ; itx = jp_otx1 935 686 ENDIF 936 687 937 688 ! do something only if we just received the stress from atmosphere 938 IF( nrcvinfo(itx)== OASIS_Rcv ) THEN689 IF( sf(itx)%ninfo == OASIS_Rcv ) THEN 939 690 940 691 ! ! ======================= ! 941 IF( s rcv(jpr_itx1)%laction) THEN ! ice stress received !692 IF( sf(jp_itx1)%loasis ) THEN ! ice stress received ! 942 693 ! ! ======================= ! 943 694 ! 944 695 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere 945 696 ! ! (cartesian to spherical -> 3 to 2 components) 946 CALL geo2oce( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1), &947 & s rcv(jpr_itx1)%clgrid, ztx, zty )948 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid949 frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid697 CALL geo2oce( sf(jp_itx1)%fnow(:,:,1), sf(jp_ity1)%fnow(:,:,1), sf(jp_itz1)%fnow(:,:,1), & 698 & sf(jp_itx1)%clvgrd, ztx, zty ) 699 sf(jp_itx1)%fnow(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid 700 sf(jp_ity1)%fnow(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid 950 701 ! 951 IF( s rcv(jpr_itx2)%laction) THEN952 CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1), &953 & s rcv(jpr_itx2)%clgrid, ztx, zty )954 frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid955 frcv(jpr_ity2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid702 IF( sf(jp_itx2)%loasis ) THEN 703 CALL geo2oce( sf(jp_itx2)%fnow(:,:,1), sf(jp_ity2)%fnow(:,:,1), sf(jp_itz2)%fnow(:,:,1), & 704 & sf(jp_itx2)%clvgrd, ztx, zty ) 705 sf(jp_itx2)%fnow(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid 706 sf(jp_ity2)%fnow(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid 956 707 ENDIF 957 708 ! … … 960 711 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 961 712 ! ! (geographical to local grid -> rotate the components) 962 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )963 IF( s rcv(jpr_itx2)%laction) THEN964 CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )713 CALL rot_rep( sf(jp_itx1)%fnow(:,:,1), sf(jp_ity1)%fnow(:,:,1), sf(jp_itx1)%clvgrd, 'en->i', ztx ) 714 IF( sf(jp_itx2)%loasis ) THEN 715 CALL rot_rep( sf(jp_itx2)%fnow(:,:,1), sf(jp_ity2)%fnow(:,:,1), sf(jp_itx2)%clvgrd, 'en->j', zty ) 965 716 ELSE 966 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty )717 CALL rot_rep( sf(jp_itx1)%fnow(:,:,1), sf(jp_ity1)%fnow(:,:,1), sf(jp_itx1)%clvgrd, 'en->j', zty ) 967 718 ENDIF 968 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid969 frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid719 sf(jp_itx1)%fnow(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 720 sf(jp_ity1)%fnow(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid 970 721 ENDIF 971 722 ! ! ======================= ! 972 723 ELSE ! use ocean stress ! 973 724 ! ! ======================= ! 974 frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1)975 frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1)725 sf(jp_itx1)%fnow(:,:,1) = sf(jp_otx1)%fnow(:,:,1) 726 sf(jp_ity1)%fnow(:,:,1) = sf(jp_oty1)%fnow(:,:,1) 976 727 ! 977 728 ENDIF … … 992 743 ! 993 744 CASE( 'I' ) ! B-grid ==> I 994 SELECT CASE ( s rcv(jpr_itx1)%clgrid )745 SELECT CASE ( sf(jp_itx1)%clvgrd ) 995 746 CASE( 'U' ) 996 747 DO jj = 2, jpjm1 ! (U,V) ==> I 997 748 DO ji = 2, jpim1 ! NO vector opt. 998 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji-1,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )999 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )749 p_taui(ji,jj) = 0.5 * ( sf(jp_itx1)%fnow(ji-1,jj ,1) + sf(jp_itx1)%fnow(ji-1,jj-1,1) ) 750 p_tauj(ji,jj) = 0.5 * ( sf(jp_ity1)%fnow(ji ,jj-1,1) + sf(jp_ity1)%fnow(ji-1,jj-1,1) ) 1000 751 END DO 1001 752 END DO … … 1003 754 DO jj = 2, jpjm1 ! F ==> I 1004 755 DO ji = 2, jpim1 ! NO vector opt. 1005 p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji-1,jj-1,1)1006 p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji-1,jj-1,1)756 p_taui(ji,jj) = sf(jp_itx1)%fnow(ji-1,jj-1,1) 757 p_tauj(ji,jj) = sf(jp_ity1)%fnow(ji-1,jj-1,1) 1007 758 END DO 1008 759 END DO … … 1010 761 DO jj = 2, jpjm1 ! T ==> I 1011 762 DO ji = 2, jpim1 ! NO vector opt. 1012 p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj ,1) &1013 & + frcv(jpr_itx1)%z3(ji,jj-1,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )1014 p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) &1015 & + frcv(jpr_oty1)%z3(ji,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )763 p_taui(ji,jj) = 0.25 * ( sf(jp_itx1)%fnow(ji,jj ,1) + sf(jp_itx1)%fnow(ji-1,jj ,1) & 764 & + sf(jp_itx1)%fnow(ji,jj-1,1) + sf(jp_itx1)%fnow(ji-1,jj-1,1) ) 765 p_tauj(ji,jj) = 0.25 * ( sf(jp_ity1)%fnow(ji,jj ,1) + sf(jp_ity1)%fnow(ji-1,jj ,1) & 766 & + sf(jp_oty1)%fnow(ji,jj-1,1) + sf(jp_ity1)%fnow(ji-1,jj-1,1) ) 1016 767 END DO 1017 768 END DO 1018 769 CASE( 'I' ) 1019 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! I ==> I1020 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)770 p_taui(:,:) = sf(jp_itx1)%fnow(:,:,1) ! I ==> I 771 p_tauj(:,:) = sf(jp_ity1)%fnow(:,:,1) 1021 772 END SELECT 1022 IF( s rcv(jpr_itx1)%clgrid /= 'I' ) THEN773 IF( sf(jp_itx1)%clvgrd /= 'I' ) THEN 1023 774 CALL lbc_lnk( p_taui, 'I', -1. ) ; CALL lbc_lnk( p_tauj, 'I', -1. ) 1024 775 ENDIF 1025 776 ! 1026 777 CASE( 'F' ) ! B-grid ==> F 1027 SELECT CASE ( s rcv(jpr_itx1)%clgrid )778 SELECT CASE ( sf(jp_itx1)%clvgrd ) 1028 779 CASE( 'U' ) 1029 780 DO jj = 2, jpjm1 ! (U,V) ==> F 1030 781 DO ji = fs_2, fs_jpim1 ! vector opt. 1031 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj+1,1) )1032 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) )782 p_taui(ji,jj) = 0.5 * ( sf(jp_itx1)%fnow(ji,jj,1) + sf(jp_itx1)%fnow(ji ,jj+1,1) ) 783 p_tauj(ji,jj) = 0.5 * ( sf(jp_ity1)%fnow(ji,jj,1) + sf(jp_ity1)%fnow(ji+1,jj ,1) ) 1033 784 END DO 1034 785 END DO … … 1036 787 DO jj = 2, jpjm1 ! I ==> F 1037 788 DO ji = 2, jpim1 ! NO vector opt. 1038 p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji+1,jj+1,1)1039 p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji+1,jj+1,1)789 p_taui(ji,jj) = sf(jp_itx1)%fnow(ji+1,jj+1,1) 790 p_tauj(ji,jj) = sf(jp_ity1)%fnow(ji+1,jj+1,1) 1040 791 END DO 1041 792 END DO … … 1043 794 DO jj = 2, jpjm1 ! T ==> F 1044 795 DO ji = 2, jpim1 ! NO vector opt. 1045 p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) &1046 & + frcv(jpr_itx1)%z3(ji,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj+1,1) )1047 p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) &1048 & + frcv(jpr_ity1)%z3(ji,jj+1,1) + frcv(jpr_ity1)%z3(ji+1,jj+1,1) )796 p_taui(ji,jj) = 0.25 * ( sf(jp_itx1)%fnow(ji,jj ,1) + sf(jp_itx1)%fnow(ji+1,jj ,1) & 797 & + sf(jp_itx1)%fnow(ji,jj+1,1) + sf(jp_itx1)%fnow(ji+1,jj+1,1) ) 798 p_tauj(ji,jj) = 0.25 * ( sf(jp_ity1)%fnow(ji,jj ,1) + sf(jp_ity1)%fnow(ji+1,jj ,1) & 799 & + sf(jp_ity1)%fnow(ji,jj+1,1) + sf(jp_ity1)%fnow(ji+1,jj+1,1) ) 1049 800 END DO 1050 801 END DO 1051 802 CASE( 'F' ) 1052 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! F ==> F1053 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)803 p_taui(:,:) = sf(jp_itx1)%fnow(:,:,1) ! F ==> F 804 p_tauj(:,:) = sf(jp_ity1)%fnow(:,:,1) 1054 805 END SELECT 1055 IF( s rcv(jpr_itx1)%clgrid /= 'F' ) THEN806 IF( sf(jp_itx1)%clvgrd /= 'F' ) THEN 1056 807 CALL lbc_lnk( p_taui, 'F', -1. ) ; CALL lbc_lnk( p_tauj, 'F', -1. ) 1057 808 ENDIF 1058 809 ! 1059 810 CASE( 'C' ) ! C-grid ==> U,V 1060 SELECT CASE ( s rcv(jpr_itx1)%clgrid )811 SELECT CASE ( sf(jp_itx1)%clvgrd ) 1061 812 CASE( 'U' ) 1062 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! (U,V) ==> (U,V)1063 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)813 p_taui(:,:) = sf(jp_itx1)%fnow(:,:,1) ! (U,V) ==> (U,V) 814 p_tauj(:,:) = sf(jp_ity1)%fnow(:,:,1) 1064 815 CASE( 'F' ) 1065 816 DO jj = 2, jpjm1 ! F ==> (U,V) 1066 817 DO ji = fs_2, fs_jpim1 ! vector opt. 1067 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj-1,1) )1068 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(jj,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) )818 p_taui(ji,jj) = 0.5 * ( sf(jp_itx1)%fnow(ji,jj,1) + sf(jp_itx1)%fnow(ji ,jj-1,1) ) 819 p_tauj(ji,jj) = 0.5 * ( sf(jp_ity1)%fnow(jj,jj,1) + sf(jp_ity1)%fnow(ji-1,jj ,1) ) 1069 820 END DO 1070 821 END DO … … 1072 823 DO jj = 2, jpjm1 ! T ==> (U,V) 1073 824 DO ji = fs_2, fs_jpim1 ! vector opt. 1074 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )1075 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )825 p_taui(ji,jj) = 0.5 * ( sf(jp_itx1)%fnow(ji+1,jj ,1) + sf(jp_itx1)%fnow(ji,jj,1) ) 826 p_tauj(ji,jj) = 0.5 * ( sf(jp_ity1)%fnow(ji ,jj+1,1) + sf(jp_ity1)%fnow(ji,jj,1) ) 1076 827 END DO 1077 828 END DO … … 1079 830 DO jj = 2, jpjm1 ! I ==> (U,V) 1080 831 DO ji = 2, jpim1 ! NO vector opt. 1081 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) )1082 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji ,jj+1,1) )832 p_taui(ji,jj) = 0.5 * ( sf(jp_itx1)%fnow(ji+1,jj+1,1) + sf(jp_itx1)%fnow(ji+1,jj ,1) ) 833 p_tauj(ji,jj) = 0.5 * ( sf(jp_ity1)%fnow(ji+1,jj+1,1) + sf(jp_ity1)%fnow(ji ,jj+1,1) ) 1083 834 END DO 1084 835 END DO 1085 836 END SELECT 1086 IF( s rcv(jpr_itx1)%clgrid /= 'U' ) THEN837 IF( sf(jp_itx1)%clvgrd /= 'U' ) THEN 1087 838 CALL lbc_lnk( p_taui, 'U', -1. ) ; CALL lbc_lnk( p_tauj, 'V', -1. ) 1088 839 ENDIF … … 1163 914 ! ! solid Precipitation (sprecip) 1164 915 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1165 CASE( 'conservative' ) ! received fields: jp r_rain, jpr_snow, jpr_ievp, jpr_tevp1166 sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here1167 tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here1168 emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:)1169 emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)1170 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation1171 IF( lk_diaar5 ) CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip.1172 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)916 CASE( 'conservative' ) ! received fields: jp_rain, jp_snow, jp_ievp, jp_tevp 917 sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) ! May need to ensure positive here 918 tprecip(:,:) = sf(jp_rain)%fnow(:,:,1) + sprecip (:,:) ! May need to ensure positive here 919 emp_tot(:,:) = sf(jp_tevp)%fnow(:,:,1) - tprecip(:,:) 920 emp_ice(:,:) = sf(jp_ievp)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) 921 CALL iom_put( 'rain' , sf(jp_rain)%fnow(:,:,1) ) ! liquid precipitation 922 IF( lk_diaar5 ) CALL iom_put( 'hflx_rain_cea', sf(jp_rain)%fnow(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 923 ztmp(:,:) = sf(jp_tevp)%fnow(:,:,1) - sf(jp_ievp)%fnow(:,:,1) * zicefr(:,:) 1173 924 CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average) 1174 925 IF( lk_diaar5 ) CALL iom_put( 'hflx_evap_cea', ztmp(:,: ) * zcptn(:,:) ) ! heat flux from from evap (cell ave) 1175 CASE( 'oce and ice' ) ! received fields: jp r_sbpr, jpr_semp, jpr_oemp, jpr_ievp1176 emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)1177 emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1)1178 sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1)926 CASE( 'oce and ice' ) ! received fields: jp_sbpr, jp_semp, jp_oemp, jp_ievp 927 emp_tot(:,:) = p_frld(:,:) * sf(jp_oemp)%fnow(:,:,1) + zicefr(:,:) * sf(jp_sbpr)%fnow(:,:,1) 928 emp_ice(:,:) = sf(jp_semp)%fnow(:,:,1) 929 sprecip(:,:) = - sf(jp_semp)%fnow(:,:,1) + sf(jp_ievp)%fnow(:,:,1) 1179 930 END SELECT 1180 931 … … 1182 933 CALL iom_put( 'snow_ao_cea', sprecip(:,: ) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1183 934 CALL iom_put( 'snow_ai_cea', sprecip(:,: ) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1184 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average)935 CALL iom_put( 'subl_ai_cea', sf(jp_ievp)%fnow(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1185 936 ! 1186 937 ! ! runoffs and calving (put in emp_tot) 1187 IF( s rcv(jpr_rnf)%laction) THEN1188 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)1189 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers1190 IF( lk_diaar5 ) CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers1191 ENDIF 1192 IF( s rcv(jpr_cal)%laction) THEN1193 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)1194 CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) )938 IF( sf(jp_rnf)%loasis ) THEN 939 emp_tot(:,:) = emp_tot(:,:) - sf(jp_rnf)%fnow(:,:,1) 940 CALL iom_put( 'runoffs' , sf(jp_rnf)%fnow(:,:,1) ) ! rivers 941 IF( lk_diaar5 ) CALL iom_put( 'hflx_rnf_cea' , sf(jp_rnf)%fnow(:,:,1) * zcptn(:,:) ) ! heat flux from rivers 942 ENDIF 943 IF( sf(jp_cal)%loasis ) THEN 944 emp_tot(:,:) = emp_tot(:,:) - sf(jp_cal)%fnow(:,:,1) 945 CALL iom_put( 'calving', sf(jp_cal)%fnow(:,:,1) ) 1195 946 ENDIF 1196 947 ! … … 1198 949 !!gm at least should be optional... 1199 950 !! ! remove negative runoff ! sum over the global domain 1200 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1201 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )951 !! zcumulpos = SUM( MAX( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 952 !! zcumulneg = SUM( MIN( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 1202 953 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) 1203 954 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 1204 955 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 1205 956 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 1206 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg957 !! sf(jp_rnf)%fnow(:,:,1) = MAX( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * zcumulneg 1207 958 !! ENDIF 1208 !! emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) ! add runoff to e-p959 !! emp_tot(:,:) = emp_tot(:,:) - sf(jp_rnf)%fnow(:,:,1) ! add runoff to e-p 1209 960 !! 1210 961 !!gm end of internal cooking … … 1214 965 ! ! ========================= ! 1215 966 CASE( 'oce only' ) ! the required field is directly provided 1216 qns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1)967 qns_tot(:,: ) = sf(jp_qnsoce)%fnow(:,:,1) 1217 968 CASE( 'conservative' ) ! the required fields are directly provided 1218 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)969 qns_tot(:,: ) = sf(jp_qnsmix)%fnow(:,:,1) 1219 970 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1220 qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)971 qns_ice(:,:,1:jpl) = sf(jp_qnsice)%fnow(:,:,1:jpl) 1221 972 ELSE 1222 973 ! Set all category values equal for the moment 1223 974 DO jl=1,jpl 1224 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)975 qns_ice(:,:,jl) = sf(jp_qnsice)%fnow(:,:,1) 1225 976 ENDDO 1226 977 ENDIF 1227 978 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1228 qns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)979 qns_tot(:,: ) = p_frld(:,:) * sf(jp_qnsoce)%fnow(:,:,1) 1229 980 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1230 981 DO jl=1,jpl 1231 qns_tot(:,: ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)1232 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)982 qns_tot(:,: ) = qns_tot(:,:) + a_i(:,:,jl) * sf(jp_qnsice)%fnow(:,:,jl) 983 qns_ice(:,:,jl) = sf(jp_qnsice)%fnow(:,:,jl) 1233 984 ENDDO 1234 985 ELSE 1235 986 DO jl=1,jpl 1236 qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1237 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)987 qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * sf(jp_qnsice)%fnow(:,:,1) 988 qns_ice(:,:,jl) = sf(jp_qnsice)%fnow(:,:,1) 1238 989 ENDDO 1239 990 ENDIF 1240 991 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1241 992 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1242 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)1243 qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) &1244 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) &993 qns_tot(:,: ) = sf(jp_qnsmix)%fnow(:,:,1) 994 qns_ice(:,:,1) = sf(jp_qnsmix)%fnow(:,:,1) & 995 & + sf(jp_dqnsdt)%fnow(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1245 996 & + pist(:,:,1) * zicefr(:,:) ) ) 1246 997 END SELECT … … 1259 1010 !! similar job should be done for snow and precipitation temperature 1260 1011 ! 1261 IF( s rcv(jpr_cal)%laction) THEN ! Iceberg melting1262 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting1012 IF( sf(jp_cal)%loasis ) THEN ! Iceberg melting 1013 ztmp(:,:) = sf(jp_cal)%fnow(:,:,1) * lfus ! add the latent heat of iceberg melting 1263 1014 qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 1264 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving1015 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + sf(jp_cal)%fnow(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1265 1016 ENDIF 1266 1017 … … 1269 1020 ! ! ========================= ! 1270 1021 CASE( 'oce only' ) 1271 qsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )1022 qsr_tot(:,: ) = MAX( 0._wp , sf(jp_qsroce)%fnow(:,:,1) ) 1272 1023 CASE( 'conservative' ) 1273 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1024 qsr_tot(:,: ) = sf(jp_qsrmix)%fnow(:,:,1) 1274 1025 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1275 qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)1026 qsr_ice(:,:,1:jpl) = sf(jp_qsrice)%fnow(:,:,1:jpl) 1276 1027 ELSE 1277 1028 ! Set all category values equal for the moment 1278 1029 DO jl=1,jpl 1279 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)1030 qsr_ice(:,:,jl) = sf(jp_qsrice)%fnow(:,:,1) 1280 1031 ENDDO 1281 1032 ENDIF 1282 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1283 qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)1033 qsr_tot(:,: ) = sf(jp_qsrmix)%fnow(:,:,1) 1034 qsr_ice(:,:,1) = sf(jp_qsrice)%fnow(:,:,1) 1284 1035 CASE( 'oce and ice' ) 1285 qsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)1036 qsr_tot(:,: ) = p_frld(:,:) * sf(jp_qsroce)%fnow(:,:,1) 1286 1037 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1287 1038 DO jl=1,jpl 1288 qsr_tot(:,: ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)1289 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)1039 qsr_tot(:,: ) = qsr_tot(:,:) + a_i(:,:,jl) * sf(jp_qsrice)%fnow(:,:,jl) 1040 qsr_ice(:,:,jl) = sf(jp_qsrice)%fnow(:,:,jl) 1290 1041 ENDDO 1291 1042 ELSE 1292 1043 DO jl=1,jpl 1293 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1294 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)1044 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * sf(jp_qsrice)%fnow(:,:,1) 1045 qsr_ice(:,:,jl) = sf(jp_qsrice)%fnow(:,:,1) 1295 1046 ENDDO 1296 1047 ENDIF 1297 1048 CASE( 'mixed oce-ice' ) 1298 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1049 qsr_tot(:,: ) = sf(jp_qsrmix)%fnow(:,:,1) 1299 1050 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1300 1051 ! Create solar heat flux over ice using incoming solar heat flux and albedos 1301 1052 ! ( see OASIS3 user guide, 5th edition, p39 ) 1302 qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) &1053 qsr_ice(:,:,1) = sf(jp_qsrmix)%fnow(:,:,1) * ( 1.- palbi(:,:,1) ) & 1303 1054 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) & 1304 1055 & + palbi (:,:,1) * zicefr(:,:) ) ) … … 1314 1065 CASE ('coupled') 1315 1066 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 1316 dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)1067 dqns_ice(:,:,1:jpl) = sf(jp_dqnsdt)%fnow(:,:,1:jpl) 1317 1068 ELSE 1318 1069 ! Set all category values equal for the moment 1319 1070 DO jl=1,jpl 1320 dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)1071 dqns_ice(:,:,jl) = sf(jp_dqnsdt)%fnow(:,:,1) 1321 1072 ENDDO 1322 1073 ENDIF … … 1325 1076 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 1326 1077 CASE ('coupled') 1327 topmelt(:,:,:)= frcv(jpr_topm)%z3(:,:,:)1328 botmelt(:,:,:)= frcv(jpr_botm)%z3(:,:,:)1078 topmelt(:,:,:)=sf(jp_topm)%fnow(:,:,:) 1079 botmelt(:,:,:)=sf(jp_botm)%fnow(:,:,:) 1329 1080 END SELECT 1330 1081
Note: See TracChangeset
for help on using the changeset viewer.
