- Timestamp:
- 2015-06-19T18:20:56+02:00 (9 years ago)
- Location:
- branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 24 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r5307 r5449 15 15 !!---------------------------------------------------------------------- 16 16 !!---------------------------------------------------------------------- 17 !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3 17 !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3-MCT 18 !! 'key_oa3mct_v3' to be added for OASIS3-MCT version 3 18 19 !!---------------------------------------------------------------------- 19 20 !! cpl_init : initialization of coupled mode communication … … 61 62 #endif 62 63 63 INTEGER, PUBLIC, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields 64 INTEGER :: nrcv ! total number of fields received 65 INTEGER :: nsnd ! total number of fields sent 66 INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 67 INTEGER, PUBLIC, PARAMETER :: nmaxfld=50 ! Maximum number of coupling fields 64 68 INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 65 69 INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields … … 86 90 CONTAINS 87 91 88 SUBROUTINE cpl_init( kl_comm )92 SUBROUTINE cpl_init( cd_modname, kl_comm ) 89 93 !!------------------------------------------------------------------- 90 94 !! *** ROUTINE cpl_init *** … … 95 99 !! ** Method : OASIS3 MPI communication 96 100 !!-------------------------------------------------------------------- 97 INTEGER, INTENT(out) :: kl_comm ! local communicator of the model 101 CHARACTER(len = *), INTENT(in) :: cd_modname ! model name as set in namcouple file 102 INTEGER , INTENT(out) :: kl_comm ! local communicator of the model 98 103 !!-------------------------------------------------------------------- 99 104 … … 104 109 ! 1st Initialize the OASIS system for the application 105 110 !------------------------------------------------------------------ 106 CALL oasis_init_comp ( ncomp_id, 'oceanx', nerror )111 CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror ) 107 112 IF ( nerror /= OASIS_Ok ) & 108 113 CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') … … 144 149 IF(lwp) WRITE(numout,*) 145 150 151 ncplmodel = kcplmodel 146 152 IF( kcplmodel > nmaxcpl ) THEN 147 CALL oasis_abort ( ncomp_id, 'cpl_define', ' kcplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN153 CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN 148 154 ENDIF 155 156 nrcv = krcv 157 IF( nrcv > nmaxfld ) THEN 158 CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld') ; RETURN 159 ENDIF 160 161 nsnd = ksnd 162 IF( nsnd > nmaxfld ) THEN 163 CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld') ; RETURN 164 ENDIF 165 149 166 ! 150 167 ! ... Define the shape for the area that excludes the halo … … 400 417 401 418 402 INTEGER FUNCTION cpl_freq( kid)419 INTEGER FUNCTION cpl_freq( cdfieldname ) 403 420 !!--------------------------------------------------------------------- 404 421 !! *** ROUTINE cpl_freq *** … … 406 423 !! ** Purpose : - send back the coupling frequency for a particular field 407 424 !!---------------------------------------------------------------------- 408 INTEGER,INTENT(in) :: kid ! variable index 409 !! 425 CHARACTER(len = *), INTENT(in) :: cdfieldname ! field name as set in namcouple file 426 !! 427 INTEGER :: id 410 428 INTEGER :: info 411 429 INTEGER, DIMENSION(1) :: itmp 430 INTEGER :: ji,jm ! local loop index 431 INTEGER :: mop 412 432 !!---------------------------------------------------------------------- 413 CALL oasis_get_freqs(kid, 1, itmp, info) 414 cpl_freq = itmp(1) 433 cpl_freq = 0 ! defaut definition 434 id = -1 ! defaut definition 435 ! 436 DO ji = 1, nsnd 437 IF (ssnd(ji)%laction ) THEN 438 DO jm = 1, ncplmodel 439 IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN 440 IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN 441 id = ssnd(ji)%nid(1,jm) 442 mop = OASIS_Out 443 ENDIF 444 ENDIF 445 ENDDO 446 ENDIF 447 ENDDO 448 DO ji = 1, nrcv 449 IF (srcv(ji)%laction ) THEN 450 DO jm = 1, ncplmodel 451 IF( srcv(ji)%nid(1,jm) /= -1 ) THEN 452 IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN 453 id = srcv(ji)%nid(1,jm) 454 mop = OASIS_In 455 ENDIF 456 ENDIF 457 ENDDO 458 ENDIF 459 ENDDO 460 ! 461 IF( id /= -1 ) THEN 462 #if defined key_oa3mct_v3 463 CALL oasis_get_freqs(id, mop, 1, itmp, info) 464 #else 465 CALL oasis_get_freqs(id, 1, itmp, info) 466 #endif 467 cpl_freq = itmp(1) 468 ENDIF 415 469 ! 416 470 END FUNCTION cpl_freq -
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90
- Property svn:keywords set to Id
-
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r5307 r5449 69 69 END TYPE FLD 70 70 71 TYPE, PUBLIC :: MAP_POINTER !: Array of integer pointers to 1D arrays 72 INTEGER, POINTER :: ptr(:) 71 TYPE, PUBLIC :: MAP_POINTER !: Map from input data file to local domain 72 INTEGER, POINTER, DIMENSION(:) :: ptr ! Array of integer pointers to 1D arrays 73 LOGICAL :: ll_unstruc ! Unstructured (T) or structured (F) boundary data file 73 74 END TYPE MAP_POINTER 74 75 … … 153 154 IF( PRESENT(kit) ) ll_firstcall = ll_firstcall .and. kit == 1 154 155 155 it_offset = 0 156 IF ( nn_components == jp_iam_sas ) THEN ; it_offset = nn_fsbc 157 ELSE ; it_offset = 0 158 ENDIF 156 159 IF( PRESENT(kt_offset) ) it_offset = kt_offset 157 160 … … 451 454 ENDIF 452 455 ! 453 it_offset = 0 456 IF ( nn_components == jp_iam_sas ) THEN ; it_offset = nn_fsbc 457 ELSE ; it_offset = 0 458 ENDIF 454 459 IF( PRESENT(kt_offset) ) it_offset = kt_offset 455 460 IF( PRESENT(kit) ) THEN ; it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) ) … … 601 606 ! 602 607 IF( ASSOCIATED(map%ptr) ) THEN 603 IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map %ptr)604 ELSE ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1), map %ptr)608 IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map ) 609 ELSE ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1), map ) 605 610 ENDIF 606 611 ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN … … 672 677 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: dta ! output field on model grid (2 dimensional) 673 678 INTEGER , INTENT(in ) :: nrec ! record number to read (ie time slice) 674 INTEGER, DIMENSION(:), INTENT(in ) :: map ! global-to-local mapping indices679 TYPE(MAP_POINTER) , INTENT(in ) :: map ! global-to-local mapping indices 675 680 !! 676 681 INTEGER :: ipi ! length of boundary data on local process … … 693 698 #if defined key_bdy 694 699 ipj = iom_file(num)%dimsz(2,idvar) 695 IF ( ipj == 1) THEN ! we assume that this is a structured open boundaryfile700 IF ( map%ll_unstruc) THEN ! unstructured open boundary data file 696 701 dta_read => dta_global 697 ELSE 702 ELSE ! structured open boundary data file 698 703 dta_read => dta_global2 699 704 ENDIF … … 708 713 END SELECT 709 714 ! 710 IF ( ipj==1) THEN715 IF ( map%ll_unstruc ) THEN ! unstructured open boundary data file 711 716 DO ib = 1, ipi 712 717 DO ik = 1, ipk 713 dta(ib,1,ik) = dta_read(map (ib),1,ik)718 dta(ib,1,ik) = dta_read(map%ptr(ib),1,ik) 714 719 END DO 715 720 END DO 716 ELSE ! we assume that this is a structured open boundaryfile721 ELSE ! structured open boundary data file 717 722 DO ib = 1, ipi 718 jj=1+floor(REAL(map (ib)-1)/REAL(ilendta))719 ji=map (ib)-(jj-1)*ilendta723 jj=1+floor(REAL(map%ptr(ib)-1)/REAL(ilendta)) 724 ji=map%ptr(ib)-(jj-1)*ilendta 720 725 DO ik = 1, ipk 721 726 dta(ib,1,ik) = dta_read(ji,jj,ik) … … 1020 1025 INTEGER :: ipk ! temporary vertical dimension 1021 1026 CHARACTER (len=5) :: aname 1022 INTEGER , DIMENSION( 3):: ddims1027 INTEGER , DIMENSION(:), ALLOCATABLE :: ddims 1023 1028 INTEGER , POINTER, DIMENSION(:,:) :: data_src 1024 1029 REAL(wp), POINTER, DIMENSION(:,:) :: data_tmp … … 1043 1048 1044 1049 !! get dimensions 1050 IF ( SIZE(sd%fnow, 3) > 1 ) THEN 1051 ALLOCATE( ddims(4) ) 1052 ELSE 1053 ALLOCATE( ddims(3) ) 1054 ENDIF 1045 1055 id = iom_varid( inum, sd%clvar, ddims ) 1046 1056 … … 1139 1149 CALL ctl_stop( ' fld_weight : unable to read the file ' ) 1140 1150 ENDIF 1151 1152 DEALLOCATE (ddims ) 1141 1153 1142 1154 CALL wrk_dealloc( jpi,jpj, data_src ) ! integer -
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r5307 r5449 16 16 USE sbc_oce ! surface boundary condition: ocean 17 17 # if defined key_lim3 18 USE par_ice! LIM-3 parameters18 USE ice ! LIM-3 parameters 19 19 # endif 20 20 # if defined key_lim2 … … 58 58 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qns_ice !: non solar heat flux over ice [W/m2] 59 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice !: solar heat flux over ice [W/m2] 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice_mean !: daily mean solar heat flux over ice [W/m2]61 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qla_ice !: latent flux over ice [W/m2] 62 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqla_ice !: latent sensibility over ice [W/m2/K] … … 69 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr1_i0 !: Solar surface transmission parameter, thick ice [-] 70 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr2_i0 !: Solar surface transmission parameter, thin ice [-] 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation - precip over sea ice [kg/m2]70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation - precip over sea ice [kg/m2/s] 72 71 73 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt !: category topmelt 74 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: botmelt !: category botmelt 74 75 #if defined key_lim3 76 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: evap_ice !: sublimation [kg/m2/s] 77 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: devap_ice !: sublimation sensitivity [kg/m2/s/K] 78 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qns_oce !: non solar heat flux over ocean [W/m2] 79 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_oce !: non solar heat flux over ocean [W/m2] 80 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qemp_oce !: heat flux of precip and evap over ocean [W/m2] 81 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qemp_ice !: heat flux of precip and evap over ice [W/m2] 82 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qprec_ice !: heat flux of precip over ice [J/m3] 83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_oce !: evap - precip over ocean [kg/m2/s] 84 #endif 85 #if defined key_lim3 || defined key_lim2 86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm_ice !: wind speed module at T-point [m/s] 87 #endif 75 88 76 89 #if defined key_cice … … 100 113 #endif 101 114 102 #if defined key_lim3 || defined key_cice 103 ! not used with LIM2 115 #if defined key_cice 104 116 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tatm_ice !: air temperature [K] 105 117 #endif … … 125 137 ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) , & 126 138 & qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) , & 127 & dqns_ice(jpi,jpj,jpl) , tn_ice (jpi,jpj,jpl) , & 128 & alb_ice (jpi,jpj,jpl) , & 129 & utau_ice(jpi,jpj) , vtau_ice(jpi,jpj) , & 139 & dqns_ice(jpi,jpj,jpl) , tn_ice (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) , & 140 & utau_ice(jpi,jpj) , vtau_ice(jpi,jpj) , wndm_ice(jpi,jpj) , & 130 141 & fr1_i0 (jpi,jpj) , fr2_i0 (jpi,jpj) , & 131 #if defined key_lim3132 & tatm_ice(jpi,jpj) , &133 #endif134 142 #if defined key_lim2 135 143 & a_i(jpi,jpj,jpl) , & 144 #endif 145 #if defined key_lim3 146 & evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) , & 147 & qemp_ice(jpi,jpj) , qemp_oce(jpi,jpj) , & 148 & qns_oce (jpi,jpj) , qsr_oce (jpi,jpj) , emp_oce (jpi,jpj) , & 136 149 #endif 137 150 & emp_ice(jpi,jpj) , STAT= ierr(1) ) … … 145 158 a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 146 159 STAT= ierr(1) ) 147 IF( l k_cpl ) ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , &160 IF( ln_cpl ) ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , & 148 161 & v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1) , & 149 162 & emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , & … … 152 165 #endif 153 166 ! 154 #if defined key_lim2155 IF( ltrcdm2dc_ice ) ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(3) )156 #endif157 !158 167 #if defined key_cice || defined key_lim2 159 IF( l k_cpl ) ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) )168 IF( ln_cpl ) ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 160 169 #endif 161 170 -
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r5307 r5449 36 36 LOGICAL , PUBLIC :: ln_blk_mfs !: MFS bulk formulation 37 37 #if defined key_oasis3 38 LOGICAL , PUBLIC :: lk_ cpl = .TRUE. !: coupled formulation38 LOGICAL , PUBLIC :: lk_oasis = .TRUE. !: OASIS used 39 39 #else 40 LOGICAL , PUBLIC :: lk_cpl = .FALSE. !: coupled formulation 41 #endif 40 LOGICAL , PUBLIC :: lk_oasis = .FALSE. !: OASIS unused 41 #endif 42 LOGICAL , PUBLIC :: ln_cpl !: ocean-atmosphere coupled formulation 43 LOGICAL , PUBLIC :: ln_mixcpl !: ocean-atmosphere forced-coupled mixed formulation 42 44 LOGICAL , PUBLIC :: ln_dm2dc !: Daily mean to Diurnal Cycle short wave (qsr) 43 45 LOGICAL , PUBLIC :: ln_rnf !: runoffs / runoff mouths … … 50 52 ! !: =1 levitating ice with mass and salt exchange but no presure effect 51 53 ! !: =2 embedded sea-ice (full salt and mass exchanges and pressure) 52 INTEGER , PUBLIC :: nn_limflx !: LIM3 Multi-category heat flux formulation 54 INTEGER , PUBLIC :: nn_components !: flag for sbc module (including sea-ice) coupling mode (see component definition below) 55 INTEGER , PUBLIC :: nn_limflx !: LIM3 Multi-category heat flux formulation 53 56 ! !: =-1 Use of per-category fluxes 54 57 ! !: = 0 Average per-category fluxes … … 69 72 !! switch definition (improve readability) 70 73 !!---------------------------------------------------------------------- 71 INTEGER , PUBLIC, PARAMETER :: jp_gyre = 0 !: GYRE analytical formulation 72 INTEGER , PUBLIC, PARAMETER :: jp_ana = 1 !: analytical formulation 73 INTEGER , PUBLIC, PARAMETER :: jp_flx = 2 !: flux formulation 74 INTEGER , PUBLIC, PARAMETER :: jp_clio = 3 !: CLIO bulk formulation 75 INTEGER , PUBLIC, PARAMETER :: jp_core = 4 !: CORE bulk formulation 76 INTEGER , PUBLIC, PARAMETER :: jp_cpl = 5 !: Coupled formulation 77 INTEGER , PUBLIC, PARAMETER :: jp_mfs = 6 !: MFS bulk formulation 74 INTEGER , PUBLIC, PARAMETER :: jp_gyre = 0 !: GYRE analytical formulation 75 INTEGER , PUBLIC, PARAMETER :: jp_ana = 1 !: analytical formulation 76 INTEGER , PUBLIC, PARAMETER :: jp_flx = 2 !: flux formulation 77 INTEGER , PUBLIC, PARAMETER :: jp_clio = 3 !: CLIO bulk formulation 78 INTEGER , PUBLIC, PARAMETER :: jp_core = 4 !: CORE bulk formulation 79 INTEGER , PUBLIC, PARAMETER :: jp_purecpl = 5 !: Pure ocean-atmosphere Coupled formulation 80 INTEGER , PUBLIC, PARAMETER :: jp_mfs = 6 !: MFS bulk formulation 81 INTEGER , PUBLIC, PARAMETER :: jp_none = 7 !: for OPA when doing coupling via SAS module 78 82 INTEGER , PUBLIC, PARAMETER :: jp_esopa = -1 !: esopa test, ALL formulations 79 83 80 84 !!---------------------------------------------------------------------- 85 !! component definition 86 !!---------------------------------------------------------------------- 87 INTEGER , PUBLIC, PARAMETER :: jp_iam_nemo = 0 !: Initial single executable configuration 88 ! (no internal OASIS coupling) 89 INTEGER , PUBLIC, PARAMETER :: jp_iam_opa = 1 !: Multi executable configuration - OPA component 90 ! (internal OASIS coupling) 91 INTEGER , PUBLIC, PARAMETER :: jp_iam_sas = 2 !: Multi executable configuration - SAS component 92 ! (internal OASIS coupling) 93 !!---------------------------------------------------------------------- 81 94 !! Ocean Surface Boundary Condition fields 82 95 !!---------------------------------------------------------------------- 96 INTEGER , PUBLIC :: ncpl_qsr_freq !: qsr coupling frequency per days from atmosphere 97 ! 83 98 LOGICAL , PUBLIC :: lhftau = .FALSE. !: HF tau used in TKE: mean(stress module) - module(mean stress) 84 LOGICAL , PUBLIC :: ltrcdm2dc !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux85 99 !! !! now ! before !! 86 100 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau , utau_b !: sea surface i-stress (ocean referential) [N/m2] … … 90 104 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm !: wind speed module at T-point (=|U10m-Uoce|) [m/s] 91 105 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr !: sea heat flux: solar [W/m2] 92 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_mean !: daily mean sea heat flux: solar [W/m2]93 106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qns , qns_b !: sea heat flux: non solar [W/m2] 94 107 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_tot !: total solar heat flux (over sea and ice) [W/m2] … … 98 111 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_tot !: total E-P over ocean and ice [Kg/m2/s] 99 112 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fmmflx !: freshwater budget: freezing/melting [Kg/m2/s] 100 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf , rnf_b !: river runoff [Kg/m2/s] 113 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf , rnf_b !: river runoff [Kg/m2/s] 114 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwfisf , fwfisf_b !: ice shelf melting [Kg/m2/s] 101 115 !! 102 116 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sbc_tsc, sbc_tsc_b !: sbc content trend [K.m/s] jpi,jpj,jpts … … 110 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: atm_co2 !: atmospheric pCO2 [ppm] 111 125 #endif 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) 112 127 113 128 !!---------------------------------------------------------------------- … … 121 136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssh_m !: mean (nn_fsbc time-step) sea surface height [m] 122 137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3t_m !: mean (nn_fsbc time-step) sea surface layer thickness [m] 138 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_m !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-] 123 139 124 140 !! * Substitutions … … 147 163 & sfx (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj), fmmflx(jpi,jpj), STAT=ierr(2) ) 148 164 ! 149 ALLOCATE( rnf (jpi,jpj) , sbc_tsc (jpi,jpj,jpts) , qsr_hc (jpi,jpj,jpk) , &150 & rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , STAT=ierr(3) )165 ALLOCATE( fwfisf (jpi,jpj), rnf (jpi,jpj) , sbc_tsc (jpi,jpj,jpts) , qsr_hc (jpi,jpj,jpk) , & 166 & fwfisf_b(jpi,jpj), rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , STAT=ierr(3) ) 151 167 ! 152 168 ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) , & … … 154 170 & atm_co2(jpi,jpj) , & 155 171 #endif 156 & ssu_m (jpi,jpj) , sst_m(jpi,jpj) , 157 & ssv_m (jpi,jpj) , sss_m (jpi,jpj), ssh_m(jpi,jpj) , STAT=ierr(4) )172 & ssu_m (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) , & 173 & ssv_m (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 158 174 ! 159 175 #if defined key_vvl 160 176 ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) ) 161 177 #endif 162 !163 IF( ltrcdm2dc ) ALLOCATE( qsr_mean(jpi,jpj) , STAT=ierr(5) )164 178 ! 165 179 sbc_oce_alloc = MAXVAL( ierr ) -
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
- Property svn:keywords set to Id
-
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r5307 r5449 34 34 USE albedo 35 35 USE prtctl ! Print control 36 #if defined key_lim3 36 #if defined key_lim3 37 37 USE ice 38 38 USE sbc_ice ! Surface boundary condition: ice fields 39 USE limthd_dh ! for CALL lim_thd_snwblow 39 40 #elif defined key_lim2 40 41 USE ice_2 42 USE sbc_ice ! Surface boundary condition: ice fields 43 USE par_ice_2 ! Surface boundary condition: ice fields 41 44 #endif 42 45 … … 45 48 46 49 PUBLIC sbc_blk_clio ! routine called by sbcmod.F90 47 PUBLIC blk_ice_clio ! routine called by sbcice_lim.F90 50 #if defined key_lim2 || defined key_lim3 51 PUBLIC blk_ice_clio_tau ! routine called by sbcice_lim.F90 52 PUBLIC blk_ice_clio_flx ! routine called by sbcice_lim.F90 53 #endif 48 54 49 55 INTEGER , PARAMETER :: jpfld = 7 ! maximum number of files to read … … 62 68 LOGICAL :: lbulk_init = .TRUE. ! flag, bulk initialization done or not) 63 69 64 #if ! defined key_lim365 ! in namicerun with LIM366 70 REAL(wp) :: cai = 1.40e-3 ! best estimate of atm drag in order to get correct FS export in ORCA2-LIM 67 71 REAL(wp) :: cao = 1.00e-3 ! chosen by default ==> should depends on many things... !!gmto be updated 68 #endif69 72 70 73 REAL(wp) :: rdtbs2 !: … … 381 384 & + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec ! add precip. heat content at Tair in Celcius 382 385 qns(:,:) = qns(:,:) * tmask(:,:,1) 386 #if defined key_lim3 387 qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) 388 qsr_oce(:,:) = qsr(:,:) 389 #endif 383 390 ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio) 384 391 385 CALL iom_put( "qlw_oce", zqlw ) ! output downward longwave heat over the ocean 386 CALL iom_put( "qsb_oce", - zqsb ) ! output downward sensible heat over the ocean 387 CALL iom_put( "qla_oce", - zqla ) ! output downward latent heat over the ocean 388 CALL iom_put( "qns_oce", qns ) ! output downward non solar heat over the ocean 392 IF ( nn_ice == 0 ) THEN 393 CALL iom_put( "qlw_oce" , zqlw ) ! output downward longwave heat over the ocean 394 CALL iom_put( "qsb_oce" , - zqsb ) ! output downward sensible heat over the ocean 395 CALL iom_put( "qla_oce" , - zqla ) ! output downward latent heat over the ocean 396 CALL iom_put( "qemp_oce", qns-zqlw+zqsb+zqla ) ! output downward heat content of E-P over the ocean 397 CALL iom_put( "qns_oce" , qns ) ! output downward non solar heat over the ocean 398 CALL iom_put( "qsr_oce" , qsr ) ! output downward solar heat over the ocean 399 CALL iom_put( "qt_oce" , qns+qsr ) ! output total downward heat over the ocean 400 ENDIF 389 401 390 402 IF(ln_ctl) THEN … … 402 414 END SUBROUTINE blk_oce_clio 403 415 404 405 SUBROUTINE blk_ice_clio( pst , palb_cs, palb_os, palb, & 406 & p_taui, p_tauj, p_qns , p_qsr, & 407 & p_qla , p_dqns, p_dqla, & 408 & p_tpr , p_spr , & 409 & p_fr1 , p_fr2 , cd_grid, pdim ) 416 # if defined key_lim2 || defined key_lim3 417 SUBROUTINE blk_ice_clio_tau 410 418 !!--------------------------------------------------------------------------- 411 !! *** ROUTINE blk_ice_clio *** 419 !! *** ROUTINE blk_ice_clio_tau *** 420 !! 421 !! ** Purpose : Computation momentum flux at the ice-atm interface 422 !! 423 !! ** Method : Read utau from a forcing file. Rearrange if C-grid 424 !! 425 !!---------------------------------------------------------------------- 426 REAL(wp) :: zcoef 427 INTEGER :: ji, jj ! dummy loop indices 428 !!--------------------------------------------------------------------- 429 ! 430 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio_tau') 431 432 SELECT CASE( cp_ice_msh ) 433 434 CASE( 'C' ) ! C-grid ice dynamics 435 436 zcoef = cai / cao ! Change from air-sea stress to air-ice stress 437 utau_ice(:,:) = zcoef * utau(:,:) 438 vtau_ice(:,:) = zcoef * vtau(:,:) 439 440 CASE( 'I' ) ! I-grid ice dynamics: I-point (i.e. F-point lower-left corner) 441 442 zcoef = 0.5_wp * cai / cao ! Change from air-sea stress to air-ice stress 443 DO jj = 2, jpj ! stress from ocean U- and V-points to ice U,V point 444 DO ji = 2, jpi ! I-grid : no vector opt. 445 utau_ice(ji,jj) = zcoef * ( utau(ji-1,jj ) + utau(ji-1,jj-1) ) 446 vtau_ice(ji,jj) = zcoef * ( vtau(ji ,jj-1) + vtau(ji-1,jj-1) ) 447 END DO 448 END DO 449 450 CALL lbc_lnk( utau_ice(:,:), 'I', -1. ) ; CALL lbc_lnk( vtau_ice(:,:), 'I', -1. ) ! I-point 451 452 END SELECT 453 454 IF(ln_ctl) THEN 455 CALL prt_ctl(tab2d_1=utau_ice , clinfo1=' blk_ice_clio: utau_ice : ', tab2d_2=vtau_ice , clinfo2=' vtau_ice : ') 456 ENDIF 457 458 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio_tau') 459 460 END SUBROUTINE blk_ice_clio_tau 461 #endif 462 463 # if defined key_lim2 || defined key_lim3 464 SUBROUTINE blk_ice_clio_flx( ptsu , palb_cs, palb_os, palb ) 465 !!--------------------------------------------------------------------------- 466 !! *** ROUTINE blk_ice_clio_flx *** 412 467 !! 413 468 !! ** Purpose : Computation of the heat fluxes at ocean and snow/ice … … 431 486 !! to take into account solid precip latent heat flux 432 487 !!---------------------------------------------------------------------- 433 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: p st! ice surface temperature [Kelvin]488 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ptsu ! ice surface temperature [Kelvin] 434 489 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_cs ! ice albedo (clear sky) (alb_ice_cs) [-] 435 490 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_os ! ice albedo (overcast sky) (alb_ice_os) [-] 436 491 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb ! ice albedo (actual value) [-] 437 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_taui ! surface ice stress at I-point (i-component) [N/m2]438 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tauj ! surface ice stress at I-point (j-component) [N/m2]439 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qns ! non solar heat flux over ice (T-point) [W/m2]440 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qsr ! solar heat flux over ice (T-point) [W/m2]441 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qla ! latent heat flux over ice (T-point) [W/m2]442 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqns ! non solar heat sensistivity (T-point) [W/m2]443 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqla ! latent heat sensistivity (T-point) [W/m2]444 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tpr ! total precipitation (T-point) [Kg/m2/s]445 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_spr ! solid precipitation (T-point) [Kg/m2/s]446 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr1 ! 1sr fraction of qsr penetration in ice [-]447 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr2 ! 2nd fraction of qsr penetration in ice [-]448 CHARACTER(len=1), INTENT(in ) :: cd_grid ! type of sea-ice grid ("C" or "B" grid)449 INTEGER, INTENT(in ) :: pdim ! number of ice categories450 492 !! 451 493 INTEGER :: ji, jj, jl ! dummy loop indices 452 INTEGER :: ijpl ! number of ice categories (size of 3rd dim of input arrays) 453 !! 454 REAL(wp) :: zcoef, zmt1, zmt2, zmt3, ztatm3 ! temporary scalars 494 !! 495 REAL(wp) :: zmt1, zmt2, zmt3, ztatm3 ! temporary scalars 455 496 REAL(wp) :: ztaevbk, zind1, zind2, zind3, ztamr ! - - 456 497 REAL(wp) :: zesi, zqsati, zdesidt ! - - … … 458 499 REAL(wp) :: zcshi, zclei, zrhovaclei, zrhovacshi ! - - 459 500 REAL(wp) :: ztice3, zticemb, zticemb2, zdqlw, zdqsb ! - - 501 REAL(wp) :: z1_lsub ! - - 460 502 !! 461 503 REAL(wp), DIMENSION(:,:) , POINTER :: ztatm ! Tair in Kelvin … … 464 506 REAL(wp), DIMENSION(:,:) , POINTER :: zrhoa ! air density 465 507 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw, z_qsb 508 REAL(wp), DIMENSION(:,:) , POINTER :: zevap, zsnw 466 509 !!--------------------------------------------------------------------- 467 510 ! 468 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio ')511 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio_flx') 469 512 ! 470 513 CALL wrk_alloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 471 CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb ) 472 473 ijpl = pdim ! number of ice categories 514 CALL wrk_alloc( jpi,jpj, jpl, z_qlw, z_qsb ) 515 474 516 zpatm = 101000. ! atmospheric pressure (assumed constant here) 475 476 #if defined key_lim3 477 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init 478 #endif 479 ! ! surface ocean fluxes computed with CLIO bulk formulea 480 !------------------------------------! 481 ! momentum fluxes (utau, vtau ) ! 482 !------------------------------------! 483 484 SELECT CASE( cd_grid ) 485 CASE( 'C' ) ! C-grid ice dynamics 486 zcoef = cai / cao ! Change from air-sea stress to air-ice stress 487 p_taui(:,:) = zcoef * utau(:,:) 488 p_tauj(:,:) = zcoef * vtau(:,:) 489 CASE( 'I' ) ! I-grid ice dynamics: I-point (i.e. F-point lower-left corner) 490 zcoef = 0.5_wp * cai / cao ! Change from air-sea stress to air-ice stress 491 DO jj = 2, jpj ! stress from ocean U- and V-points to ice U,V point 492 DO ji = 2, jpi ! I-grid : no vector opt. 493 p_taui(ji,jj) = zcoef * ( utau(ji-1,jj ) + utau(ji-1,jj-1) ) 494 p_tauj(ji,jj) = zcoef * ( vtau(ji ,jj-1) + vtau(ji-1,jj-1) ) 495 END DO 496 END DO 497 CALL lbc_lnk( p_taui(:,:), 'I', -1. ) ; CALL lbc_lnk( p_tauj(:,:), 'I', -1. ) ! I-point 498 END SELECT 499 500 517 !-------------------------------------------------------------------------------- 501 518 ! Determine cloud optical depths as a function of latitude (Chou et al., 1981). 502 519 ! and the correction factor for taking into account the effect of clouds 503 !------------------------------------------------------ 520 !-------------------------------------------------------------------------------- 521 504 522 !CDIR NOVERRCHK 505 523 !CDIR COLLAPSE … … 528 546 zmt2 = ( 272.0 - ztatm(ji,jj) ) / 38.0 ; zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) ) 529 547 zmt3 = ( 281.0 - ztatm(ji,jj) ) / 18.0 ; zind3 = MAX( 0.e0, SIGN( 1.e0, zmt3 ) ) 530 p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday & ! rday = converte mm/day to kg/m2/s548 sprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday & ! rday = converte mm/day to kg/m2/s 531 549 & * ( zind1 & ! solid (snow) precipitation [kg/m2/s] 532 550 & + ( 1.0 - zind1 ) * ( zind2 * ( 0.5 + zmt2 ) & … … 538 556 ! fraction of qsr_ice which is NOT absorbed in the thin surface layer 539 557 ! and thus which penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 540 p_fr1(ji,jj) = 0.18 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1)541 p_fr2(ji,jj) = 0.82 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1)542 END DO 543 END DO 544 CALL iom_put( 'snowpre', p_spr) ! Snow precipitation558 fr1_i0(ji,jj) = 0.18 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1) 559 fr2_i0(ji,jj) = 0.82 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1) 560 END DO 561 END DO 562 CALL iom_put( 'snowpre', sprecip ) ! Snow precipitation 545 563 546 564 !-----------------------------------------------------------! 547 565 ! snow/ice Shortwave radiation (abedo already computed) ! 548 566 !-----------------------------------------------------------! 549 CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr)550 551 DO jl = 1, ijpl567 CALL blk_clio_qsr_ice( palb_cs, palb_os, qsr_ice ) 568 569 DO jl = 1, jpl 552 570 palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(:,:,1) ) & 553 571 & + palb_os(:,:,jl) * sf(jp_ccov)%fnow(:,:,1) ) … … 555 573 556 574 ! ! ========================== ! 557 DO jl = 1, ijpl ! Loop over ice categories !575 DO jl = 1, jpl ! Loop over ice categories ! 558 576 ! ! ========================== ! 559 577 !CDIR NOVERRCHK … … 569 587 ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) ) 570 588 ! 571 z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( p st(ji,jj,jl) - ztatm(ji,jj) ) )589 z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) ) 572 590 573 591 !---------------------------------------- … … 576 594 577 595 ! vapour pressure at saturation of ice (tmask to avoid overflow in the exponential) 578 zesi = 611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( p st(ji,jj,jl) - rtt )/ ( pst(ji,jj,jl) - 7.66 ) )596 zesi = 611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( ptsu(ji,jj,jl) - rtt )/ ( ptsu(ji,jj,jl) - 7.66 ) ) 579 597 ! humidity close to the ice surface (at saturation) 580 598 zqsati = ( 0.622 * zesi ) / ( zpatm - 0.378 * zesi ) 581 599 582 600 ! computation of intermediate values 583 zticemb = p st(ji,jj,jl) - 7.66601 zticemb = ptsu(ji,jj,jl) - 7.66 584 602 zticemb2 = zticemb * zticemb 585 ztice3 = p st(ji,jj,jl) * pst(ji,jj,jl) * pst(ji,jj,jl)603 ztice3 = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) * ptsu(ji,jj,jl) 586 604 zdesidt = zesi * ( 9.5 * LOG( 10.0 ) * ( rtt - 7.66 ) / zticemb2 ) 587 605 … … 596 614 597 615 ! sensible heat flux 598 z_qsb(ji,jj,jl) = zrhovacshi * ( p st(ji,jj,jl) - ztatm(ji,jj) )616 z_qsb(ji,jj,jl) = zrhovacshi * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) 599 617 600 618 ! latent heat flux 601 p_qla(ji,jj,jl) = MAX( 0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) ) )619 qla_ice(ji,jj,jl) = MAX( 0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) ) ) 602 620 603 621 ! sensitivity of non solar fluxes (dQ/dT) (long-wave, sensible and latent fluxes) … … 606 624 zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) ) 607 625 ! 608 p_dqla(ji,jj,jl) = zdqla ! latent flux sensitivity609 p_dqns(ji,jj,jl) = -( zdqlw + zdqsb + zdqla ) ! total non solar sensitivity626 dqla_ice(ji,jj,jl) = zdqla ! latent flux sensitivity 627 dqns_ice(ji,jj,jl) = -( zdqlw + zdqsb + zdqla ) ! total non solar sensitivity 610 628 END DO 611 629 ! … … 619 637 ! 620 638 !CDIR COLLAPSE 621 p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla(:,:,:) ! Downward Non Solar flux622 !CDIR COLLAPSE 623 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s]639 qns_ice(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - qla_ice (:,:,:) ! Downward Non Solar flux 640 !CDIR COLLAPSE 641 tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s] 624 642 ! 625 643 ! ----------------------------------------------------------------------------- ! … … 628 646 !CDIR COLLAPSE 629 647 qns(:,:) = qns(:,:) & ! update the non-solar heat flux with: 630 & - p_spr(:,:) * lfus & ! remove melting solid precip 631 & + p_spr(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic & ! add solid P at least below melting 632 & - p_spr(:,:) * sf(jp_tair)%fnow(:,:,1) * rcp ! remove solid precip. at Tair 633 ! 648 & - sprecip(:,:) * lfus & ! remove melting solid precip 649 & + sprecip(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic & ! add solid P at least below melting 650 & - sprecip(:,:) * sf(jp_tair)%fnow(:,:,1) * rcp ! remove solid precip. at Tair 651 652 #if defined key_lim3 653 ! ----------------------------------------------------------------------------- ! 654 ! Distribute evapo, precip & associated heat over ice and ocean 655 ! ---------------=====--------------------------------------------------------- ! 656 CALL wrk_alloc( jpi,jpj, zevap, zsnw ) 657 658 ! --- evaporation --- ! 659 z1_lsub = 1._wp / Lsub 660 evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation 661 devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub 662 zevap (:,:) = emp(:,:) + tprecip(:,:) ! evaporation over ocean 663 664 ! --- evaporation minus precipitation --- ! 665 CALL lim_thd_snwblow( pfrld, zsnw ) ! snow redistribution by wind 666 emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * ( 1._wp - zsnw ) 667 emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 668 emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 669 670 ! --- heat flux associated with emp --- ! 671 qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp & ! evap 672 & + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & ! liquid precip 673 & + sprecip(:,:) * ( 1._wp - zsnw ) * & ! solid precip 674 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 675 qemp_ice(:,:) = sprecip(:,:) * zsnw * & ! solid precip (only) 676 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 677 678 ! --- total solar and non solar fluxes --- ! 679 qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 680 qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 681 682 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 683 qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 684 685 CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) 686 #endif 687 634 688 !!gm : not necessary as all input data are lbc_lnk... 635 CALL lbc_lnk( p_fr1(:,:) , 'T', 1. )636 CALL lbc_lnk( p_fr2(:,:) , 'T', 1. )637 DO jl = 1, ijpl638 CALL lbc_lnk( p_qns(:,:,jl) , 'T', 1. )639 CALL lbc_lnk( p_dqns(:,:,jl) , 'T', 1. )640 CALL lbc_lnk( p_qla(:,:,jl) , 'T', 1. )641 CALL lbc_lnk( p_dqla(:,:,jl) , 'T', 1. )689 CALL lbc_lnk( fr1_i0 (:,:) , 'T', 1. ) 690 CALL lbc_lnk( fr2_i0 (:,:) , 'T', 1. ) 691 DO jl = 1, jpl 692 CALL lbc_lnk( qns_ice (:,:,jl) , 'T', 1. ) 693 CALL lbc_lnk( dqns_ice(:,:,jl) , 'T', 1. ) 694 CALL lbc_lnk( qla_ice (:,:,jl) , 'T', 1. ) 695 CALL lbc_lnk( dqla_ice(:,:,jl) , 'T', 1. ) 642 696 END DO 643 697 644 698 !!gm : mask is not required on forcing 645 DO jl = 1, ijpl 646 p_qns (:,:,jl) = p_qns (:,:,jl) * tmask(:,:,1) 647 p_qla (:,:,jl) = p_qla (:,:,jl) * tmask(:,:,1) 648 p_dqns(:,:,jl) = p_dqns(:,:,jl) * tmask(:,:,1) 649 p_dqla(:,:,jl) = p_dqla(:,:,jl) * tmask(:,:,1) 650 END DO 699 DO jl = 1, jpl 700 qns_ice (:,:,jl) = qns_ice (:,:,jl) * tmask(:,:,1) 701 qla_ice (:,:,jl) = qla_ice (:,:,jl) * tmask(:,:,1) 702 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * tmask(:,:,1) 703 dqla_ice(:,:,jl) = dqla_ice(:,:,jl) * tmask(:,:,1) 704 END DO 705 706 CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 707 CALL wrk_dealloc( jpi,jpj, jpl , z_qlw, z_qsb ) 651 708 652 709 IF(ln_ctl) THEN 653 CALL prt_ctl(tab3d_1=z_qsb , clinfo1=' blk_ice_clio: z_qsb : ', tab3d_2=z_qlw , clinfo2=' z_qlw : ', kdim=ijpl) 654 CALL prt_ctl(tab3d_1=p_qla , clinfo1=' blk_ice_clio: z_qla : ', tab3d_2=p_qsr , clinfo2=' p_qsr : ', kdim=ijpl) 655 CALL prt_ctl(tab3d_1=p_dqns , clinfo1=' blk_ice_clio: p_dqns : ', tab3d_2=p_qns , clinfo2=' p_qns : ', kdim=ijpl) 656 CALL prt_ctl(tab3d_1=p_dqla , clinfo1=' blk_ice_clio: p_dqla : ', tab3d_2=pst , clinfo2=' pst : ', kdim=ijpl) 657 CALL prt_ctl(tab2d_1=p_tpr , clinfo1=' blk_ice_clio: p_tpr : ', tab2d_2=p_spr , clinfo2=' p_spr : ') 658 CALL prt_ctl(tab2d_1=p_taui , clinfo1=' blk_ice_clio: p_taui : ', tab2d_2=p_tauj , clinfo2=' p_tauj : ') 710 CALL prt_ctl(tab3d_1=z_qsb , clinfo1=' blk_ice_clio: z_qsb : ', tab3d_2=z_qlw , clinfo2=' z_qlw : ', kdim=jpl) 711 CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice_clio: z_qla : ', tab3d_2=qsr_ice , clinfo2=' qsr_ice : ', kdim=jpl) 712 CALL prt_ctl(tab3d_1=dqns_ice , clinfo1=' blk_ice_clio: dqns_ice : ', tab3d_2=qns_ice , clinfo2=' qns_ice : ', kdim=jpl) 713 CALL prt_ctl(tab3d_1=dqla_ice , clinfo1=' blk_ice_clio: dqla_ice : ', tab3d_2=ptsu , clinfo2=' ptsu : ', kdim=jpl) 714 CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice_clio: tprecip : ', tab2d_2=sprecip , clinfo2=' sprecip : ') 659 715 ENDIF 660 716 661 CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 662 CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb ) 663 ! 664 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio') 665 ! 666 END SUBROUTINE blk_ice_clio 667 717 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio_flx') 718 ! 719 END SUBROUTINE blk_ice_clio_flx 720 721 #endif 668 722 669 723 SUBROUTINE blk_clio_qsr_oce( pqsr_oce ) -
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r5307 r5449 22 22 !! blk_oce_core : computes momentum, heat and freshwater fluxes over ocean 23 23 !! blk_ice_core : computes momentum, heat and freshwater fluxes over ice 24 !! blk_bio_meanqsr : compute daily mean short wave radiation over the ocean25 !! blk_ice_meanqsr : compute daily mean short wave radiation over the ice26 24 !! turb_core_2z : Computes turbulent transfert coefficients 27 25 !! cd_neutral_10m : Estimate of the neutral drag coefficient at 10m … … 46 44 USE sbc_ice ! Surface boundary condition: ice fields 47 45 USE lib_fortran ! to use key_nosignedzero 46 #if defined key_lim3 47 USE ice, ONLY : u_ice, v_ice, jpl, pfrld, a_i_b 48 USE limthd_dh ! for CALL lim_thd_snwblow 49 #elif defined key_lim2 50 USE ice_2, ONLY : u_ice, v_ice 51 USE par_ice_2 52 #endif 48 53 49 54 IMPLICIT NONE … … 51 56 52 57 PUBLIC sbc_blk_core ! routine called in sbcmod module 53 PUBLIC blk_ice_core ! routine called in sbc_ice_lim module 54 PUBLIC blk_ice_meanqsr ! routine called in sbc_ice_lim module 58 #if defined key_lim2 || defined key_lim3 59 PUBLIC blk_ice_core_tau ! routine called in sbc_ice_lim module 60 PUBLIC blk_ice_core_flx ! routine called in sbc_ice_lim module 61 #endif 55 62 PUBLIC turb_core_2z ! routine calles in sbcblk_mfs module 56 63 … … 195 202 ! ! compute the surface ocean fluxes using CORE bulk formulea 196 203 IF( MOD( kt - 1, nn_fsbc ) == 0 ) CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m ) 197 198 ! If diurnal cycle is activated, compute a daily mean short waves flux for biogeochemistery199 IF( ltrcdm2dc ) CALL blk_bio_meanqsr200 204 201 205 #if defined key_cice … … 302 306 ELSE ; qsr(:,:) = zztmp * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1) 303 307 ENDIF 308 304 309 zqlw(:,:) = ( sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave 305 310 ! ----------------------------------------------------------------------------- ! … … 376 381 emp (:,:) = ( zevap(:,:) & ! mass flux (evap. - precip.) 377 382 & - sf(jp_prec)%fnow(:,:,1) * rn_pfac ) * tmask(:,:,1) 378 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar flux 383 ! 384 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar 379 385 & - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus & ! remove latent melting heat for solid precip 380 386 & - zevap(:,:) * pst(:,:) * rcp & ! remove evap heat content at SST … … 384 390 & * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) 385 391 ! 386 CALL iom_put( "qlw_oce", zqlw ) ! output downward longwave heat over the ocean 387 CALL iom_put( "qsb_oce", - zqsb ) ! output downward sensible heat over the ocean 388 CALL iom_put( "qla_oce", - zqla ) ! output downward latent heat over the ocean 389 CALL iom_put( "qhc_oce", qns-zqlw+zqsb+zqla ) ! output downward heat content of E-P over the ocean 390 CALL iom_put( "qns_oce", qns ) ! output downward non solar heat over the ocean 392 #if defined key_lim3 393 qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) ! non solar without emp (only needed by LIM3) 394 qsr_oce(:,:) = qsr(:,:) 395 #endif 396 ! 397 IF ( nn_ice == 0 ) THEN 398 CALL iom_put( "qlw_oce" , zqlw ) ! output downward longwave heat over the ocean 399 CALL iom_put( "qsb_oce" , - zqsb ) ! output downward sensible heat over the ocean 400 CALL iom_put( "qla_oce" , - zqla ) ! output downward latent heat over the ocean 401 CALL iom_put( "qemp_oce", qns-zqlw+zqsb+zqla ) ! output downward heat content of E-P over the ocean 402 CALL iom_put( "qns_oce" , qns ) ! output downward non solar heat over the ocean 403 CALL iom_put( "qsr_oce" , qsr ) ! output downward solar heat over the ocean 404 CALL iom_put( "qt_oce" , qns+qsr ) ! output total downward heat over the ocean 405 ENDIF 391 406 ! 392 407 IF(ln_ctl) THEN … … 406 421 407 422 408 SUBROUTINE blk_ice_core( pst , pui , pvi , palb , & 409 & p_taui, p_tauj, p_qns , p_qsr, & 410 & p_qla , p_dqns, p_dqla, & 411 & p_tpr , p_spr , & 412 & p_fr1 , p_fr2 , cd_grid, pdim ) 413 !!--------------------------------------------------------------------- 414 !! *** ROUTINE blk_ice_core *** 423 #if defined key_lim2 || defined key_lim3 424 SUBROUTINE blk_ice_core_tau 425 !!--------------------------------------------------------------------- 426 !! *** ROUTINE blk_ice_core_tau *** 415 427 !! 416 428 !! ** Purpose : provide the surface boundary condition over sea-ice 417 429 !! 418 !! ** Method : compute momentum, heat and freshwater exchanged 419 !! between atmosphere and sea-ice using CORE bulk 420 !! formulea, ice variables and read atmmospheric fields. 430 !! ** Method : compute momentum using CORE bulk 431 !! formulea, ice variables and read atmospheric fields. 421 432 !! NB: ice drag coefficient is assumed to be a constant 422 !! 423 !! caution : the net upward water flux has with mm/day unit 424 !!--------------------------------------------------------------------- 425 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pst ! ice surface temperature (>0, =rt0 over land) [Kelvin] 426 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pui ! ice surface velocity (i- and i- components [m/s] 427 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pvi ! at I-point (B-grid) or U & V-point (C-grid) 428 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb ! ice albedo (all skies) [%] 429 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_taui ! i- & j-components of surface ice stress [N/m2] 430 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) 431 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_qns ! non solar heat flux over ice (T-point) [W/m2] 432 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_qsr ! solar heat flux over ice (T-point) [W/m2] 433 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_qla ! latent heat flux over ice (T-point) [W/m2] 434 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_dqns ! non solar heat sensistivity (T-point) [W/m2] 435 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_dqla ! latent heat sensistivity (T-point) [W/m2] 436 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_tpr ! total precipitation (T-point) [Kg/m2/s] 437 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_spr ! solid precipitation (T-point) [Kg/m2/s] 438 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_fr1 ! 1sr fraction of qsr penetration in ice (T-point) [%] 439 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_fr2 ! 2nd fraction of qsr penetration in ice (T-point) [%] 440 CHARACTER(len=1) , INTENT(in ) :: cd_grid ! ice grid ( C or B-grid) 441 INTEGER , INTENT(in ) :: pdim ! number of ice categories 442 !! 443 INTEGER :: ji, jj, jl ! dummy loop indices 444 INTEGER :: ijpl ! number of ice categories (size of 3rd dim of input arrays) 445 REAL(wp) :: zst2, zst3 446 REAL(wp) :: zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb 447 REAL(wp) :: zztmp ! temporary variable 448 REAL(wp) :: zwnorm_f, zwndi_f , zwndj_f ! relative wind module and components at F-point 449 REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point 450 !! 451 REAL(wp), DIMENSION(:,:) , POINTER :: z_wnds_t ! wind speed ( = | U10m - U_ice | ) at T-point 452 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw ! long wave heat flux over ice 453 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qsb ! sensible heat flux over ice 454 REAL(wp), DIMENSION(:,:,:), POINTER :: z_dqlw ! long wave heat sensitivity over ice 455 REAL(wp), DIMENSION(:,:,:), POINTER :: z_dqsb ! sensible heat sensitivity over ice 456 !!--------------------------------------------------------------------- 457 ! 458 IF( nn_timing == 1 ) CALL timing_start('blk_ice_core') 459 ! 460 CALL wrk_alloc( jpi,jpj, z_wnds_t ) 461 CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb, z_dqlw, z_dqsb ) 462 463 ijpl = pdim ! number of ice categories 464 433 !!--------------------------------------------------------------------- 434 INTEGER :: ji, jj ! dummy loop indices 435 REAL(wp) :: zcoef_wnorm, zcoef_wnorm2 436 REAL(wp) :: zwnorm_f, zwndi_f , zwndj_f ! relative wind module and components at F-point 437 REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point 438 !!--------------------------------------------------------------------- 439 ! 440 IF( nn_timing == 1 ) CALL timing_start('blk_ice_core_tau') 441 ! 465 442 ! local scalars ( place there for vector optimisation purposes) 466 443 zcoef_wnorm = rhoa * Cice 467 444 zcoef_wnorm2 = rhoa * Cice * 0.5 468 zcoef_dqlw = 4.0 * 0.95 * Stef469 zcoef_dqla = -Ls * Cice * 11637800. * (-5897.8)470 zcoef_dqsb = rhoa * cpa * Cice471 445 472 446 !!gm brutal.... 473 z_wnds_t(:,:) = 0.e0474 p_taui (:,:) = 0.e0475 p_tauj (:,:) = 0.e0447 utau_ice (:,:) = 0._wp 448 vtau_ice (:,:) = 0._wp 449 wndm_ice (:,:) = 0._wp 476 450 !!gm end 477 451 478 #if defined key_lim3479 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init480 #endif481 452 ! ----------------------------------------------------------------------------- ! 482 453 ! Wind components and module relative to the moving ocean ( U10m - U_ice ) ! 483 454 ! ----------------------------------------------------------------------------- ! 484 SELECT CASE( c d_grid)455 SELECT CASE( cp_ice_msh ) 485 456 CASE( 'I' ) ! B-grid ice dynamics : I-point (i.e. F-point with sea-ice indexation) 486 457 ! and scalar wind at T-point ( = | U10m - U_ice | ) (masked) … … 489 460 ! ... scalar wind at I-point (fld being at T-point) 490 461 zwndi_f = 0.25 * ( sf(jp_wndi)%fnow(ji-1,jj ,1) + sf(jp_wndi)%fnow(ji ,jj ,1) & 491 & + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji ,jj-1,1) ) - rn_vfac * pui(ji,jj)462 & + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji ,jj-1,1) ) - rn_vfac * u_ice(ji,jj) 492 463 zwndj_f = 0.25 * ( sf(jp_wndj)%fnow(ji-1,jj ,1) + sf(jp_wndj)%fnow(ji ,jj ,1) & 493 & + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji ,jj-1,1) ) - rn_vfac * pvi(ji,jj)464 & + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji ,jj-1,1) ) - rn_vfac * v_ice(ji,jj) 494 465 zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 495 466 ! ... ice stress at I-point 496 p_taui(ji,jj) = zwnorm_f * zwndi_f497 p_tauj(ji,jj) = zwnorm_f * zwndj_f467 utau_ice(ji,jj) = zwnorm_f * zwndi_f 468 vtau_ice(ji,jj) = zwnorm_f * zwndj_f 498 469 ! ... scalar wind at T-point (fld being at T-point) 499 zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * ( pui(ji,jj+1) + pui(ji+1,jj+1) &500 & + pui(ji,jj ) + pui(ji+1,jj ) )501 zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * ( pvi(ji,jj+1) + pvi(ji+1,jj+1) &502 & + pvi(ji,jj ) + pvi(ji+1,jj ) )503 z_wnds_t(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)470 zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * ( u_ice(ji,jj+1) + u_ice(ji+1,jj+1) & 471 & + u_ice(ji,jj ) + u_ice(ji+1,jj ) ) 472 zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * ( v_ice(ji,jj+1) + v_ice(ji+1,jj+1) & 473 & + v_ice(ji,jj ) + v_ice(ji+1,jj ) ) 474 wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 504 475 END DO 505 476 END DO 506 CALL lbc_lnk( p_taui, 'I', -1. )507 CALL lbc_lnk( p_tauj, 'I', -1. )508 CALL lbc_lnk( z_wnds_t, 'T', 1. )477 CALL lbc_lnk( utau_ice, 'I', -1. ) 478 CALL lbc_lnk( vtau_ice, 'I', -1. ) 479 CALL lbc_lnk( wndm_ice, 'T', 1. ) 509 480 ! 510 481 CASE( 'C' ) ! C-grid ice dynamics : U & V-points (same as ocean) 511 482 DO jj = 2, jpj 512 483 DO ji = fs_2, jpi ! vect. opt. 513 zwndi_t = ( sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pui(ji-1,jj ) + pui(ji,jj) ) )514 zwndj_t = ( sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pvi(ji ,jj-1) + pvi(ji,jj) ) )515 z_wnds_t(ji,jj)= SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)484 zwndi_t = ( sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj ) + u_ice(ji,jj) ) ) 485 zwndj_t = ( sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji ,jj-1) + v_ice(ji,jj) ) ) 486 wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 516 487 END DO 517 488 END DO 518 489 DO jj = 2, jpjm1 519 490 DO ji = fs_2, fs_jpim1 ! vect. opt. 520 p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj ) + z_wnds_t(ji,jj) ) &521 & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * pui(ji,jj) )522 p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1 ) + z_wnds_t(ji,jj) ) &523 & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * pvi(ji,jj) )491 utau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji+1,jj ) + wndm_ice(ji,jj) ) & 492 & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) ) 493 vtau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji,jj+1 ) + wndm_ice(ji,jj) ) & 494 & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) ) 524 495 END DO 525 496 END DO 526 CALL lbc_lnk( p_taui, 'U', -1. )527 CALL lbc_lnk( p_tauj, 'V', -1. )528 CALL lbc_lnk( z_wnds_t, 'T', 1. )497 CALL lbc_lnk( utau_ice, 'U', -1. ) 498 CALL lbc_lnk( vtau_ice, 'V', -1. ) 499 CALL lbc_lnk( wndm_ice, 'T', 1. ) 529 500 ! 530 501 END SELECT 502 503 IF(ln_ctl) THEN 504 CALL prt_ctl(tab2d_1=utau_ice , clinfo1=' blk_ice_core: utau_ice : ', tab2d_2=vtau_ice , clinfo2=' vtau_ice : ') 505 CALL prt_ctl(tab2d_1=wndm_ice , clinfo1=' blk_ice_core: wndm_ice : ') 506 ENDIF 507 508 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_core_tau') 509 510 END SUBROUTINE blk_ice_core_tau 511 512 513 SUBROUTINE blk_ice_core_flx( ptsu, palb ) 514 !!--------------------------------------------------------------------- 515 !! *** ROUTINE blk_ice_core_flx *** 516 !! 517 !! ** Purpose : provide the surface boundary condition over sea-ice 518 !! 519 !! ** Method : compute heat and freshwater exchanged 520 !! between atmosphere and sea-ice using CORE bulk 521 !! formulea, ice variables and read atmmospheric fields. 522 !! 523 !! caution : the net upward water flux has with mm/day unit 524 !!--------------------------------------------------------------------- 525 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: ptsu ! sea ice surface temperature 526 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: palb ! ice albedo (all skies) 527 !! 528 INTEGER :: ji, jj, jl ! dummy loop indices 529 REAL(wp) :: zst2, zst3 530 REAL(wp) :: zcoef_dqlw, zcoef_dqla, zcoef_dqsb 531 REAL(wp) :: zztmp, z1_lsub ! temporary variable 532 !! 533 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw ! long wave heat flux over ice 534 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qsb ! sensible heat flux over ice 535 REAL(wp), DIMENSION(:,:,:), POINTER :: z_dqlw ! long wave heat sensitivity over ice 536 REAL(wp), DIMENSION(:,:,:), POINTER :: z_dqsb ! sensible heat sensitivity over ice 537 REAL(wp), DIMENSION(:,:) , POINTER :: zevap, zsnw ! evaporation and snw distribution after wind blowing (LIM3) 538 !!--------------------------------------------------------------------- 539 ! 540 IF( nn_timing == 1 ) CALL timing_start('blk_ice_core_flx') 541 ! 542 CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 543 544 ! local scalars ( place there for vector optimisation purposes) 545 zcoef_dqlw = 4.0 * 0.95 * Stef 546 zcoef_dqla = -Ls * Cice * 11637800. * (-5897.8) 547 zcoef_dqsb = rhoa * cpa * Cice 531 548 532 549 zztmp = 1. / ( 1. - albo ) 533 550 ! ! ========================== ! 534 DO jl = 1, ijpl! Loop over ice categories !551 DO jl = 1, jpl ! Loop over ice categories ! 535 552 ! ! ========================== ! 536 553 DO jj = 1 , jpj … … 539 556 ! I Radiative FLUXES ! 540 557 ! ----------------------------! 541 zst2 = p st(ji,jj,jl) * pst(ji,jj,jl)542 zst3 = p st(ji,jj,jl) * zst2558 zst2 = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) 559 zst3 = ptsu(ji,jj,jl) * zst2 543 560 ! Short Wave (sw) 544 p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj)561 qsr_ice(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 545 562 ! Long Wave (lw) 546 z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * p st(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)563 z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 547 564 ! lw sensitivity 548 565 z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3 … … 554 571 ! ... turbulent heat fluxes 555 572 ! Sensible Heat 556 z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) )573 z_qsb(ji,jj,jl) = rhoa * cpa * Cice * wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 557 574 ! Latent Heat 558 p_qla(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls * Cice * z_wnds_t(ji,jj) &559 & * ( 11637800. * EXP( -5897.8 / p st(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1) ) )560 561 IF( p_qla(ji,jj,jl) > 0._wp ) THEN562 p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) )575 qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls * Cice * wndm_ice(ji,jj) & 576 & * ( 11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1) ) ) 577 ! Latent heat sensitivity for ice (Dqla/Dt) 578 IF( qla_ice(ji,jj,jl) > 0._wp ) THEN 579 dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * wndm_ice(ji,jj) / ( zst2 ) * EXP( -5897.8 / ptsu(ji,jj,jl) ) 563 580 ELSE 564 p_dqla(ji,jj,jl) = 0._wp581 dqla_ice(ji,jj,jl) = 0._wp 565 582 ENDIF 566 583 567 584 ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 568 z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj)585 z_dqsb(ji,jj,jl) = zcoef_dqsb * wndm_ice(ji,jj) 569 586 570 587 ! ----------------------------! … … 572 589 ! ----------------------------! 573 590 ! Downward Non Solar flux 574 p_qns (ji,jj,jl) = z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - p_qla(ji,jj,jl)591 qns_ice (ji,jj,jl) = z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - qla_ice (ji,jj,jl) 575 592 ! Total non solar heat flux sensitivity for ice 576 p_dqns(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + p_dqla(ji,jj,jl) )593 dqns_ice(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + dqla_ice(ji,jj,jl) ) 577 594 END DO 578 595 ! … … 581 598 END DO 582 599 ! 600 tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac ! total precipitation [kg/m2/s] 601 sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac ! solid precipitation [kg/m2/s] 602 CALL iom_put( 'snowpre', sprecip * 86400. ) ! Snow precipitation 603 CALL iom_put( 'precip' , tprecip * 86400. ) ! Total precipitation 604 605 #if defined key_lim3 606 CALL wrk_alloc( jpi,jpj, zevap, zsnw ) 607 608 ! --- evaporation --- ! 609 z1_lsub = 1._wp / Lsub 610 evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation 611 devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub 612 zevap (:,:) = emp(:,:) + tprecip(:,:) ! evaporation over ocean 613 614 ! --- evaporation minus precipitation --- ! 615 CALL lim_thd_snwblow( pfrld, zsnw ) ! snow distribution over ice after wind blowing 616 emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 617 emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 618 emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 619 620 ! --- heat flux associated with emp --- ! 621 qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp & ! evap at sst 622 & + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & ! liquid precip at Tair 623 & + sprecip(:,:) * ( 1._wp - zsnw ) * & ! solid precip at min(Tair,Tsnow) 624 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 625 qemp_ice(:,:) = sprecip(:,:) * zsnw * & ! solid precip (only) 626 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 627 628 ! --- total solar and non solar fluxes --- ! 629 qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 630 qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 631 632 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 633 qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 634 635 CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) 636 #endif 637 583 638 !-------------------------------------------------------------------- 584 639 ! FRACTIONs of net shortwave radiation which is not absorbed in the … … 586 641 ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 587 642 ! 588 p_fr1(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 589 p_fr2(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 590 ! 591 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac ! total precipitation [kg/m2/s] 592 p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac ! solid precipitation [kg/m2/s] 593 CALL iom_put( 'snowpre', p_spr * 86400. ) ! Snow precipitation 594 CALL iom_put( 'precip' , p_tpr * 86400. ) ! Total precipitation 643 fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 644 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 645 ! 595 646 ! 596 647 IF(ln_ctl) THEN 597 CALL prt_ctl(tab3d_1=p_qla , clinfo1=' blk_ice_core: p_qla : ', tab3d_2=z_qsb , clinfo2=' z_qsb : ', kdim=ijpl) 598 CALL prt_ctl(tab3d_1=z_qlw , clinfo1=' blk_ice_core: z_qlw : ', tab3d_2=p_dqla , clinfo2=' p_dqla : ', kdim=ijpl) 599 CALL prt_ctl(tab3d_1=z_dqsb , clinfo1=' blk_ice_core: z_dqsb : ', tab3d_2=z_dqlw , clinfo2=' z_dqlw : ', kdim=ijpl) 600 CALL prt_ctl(tab3d_1=p_dqns , clinfo1=' blk_ice_core: p_dqns : ', tab3d_2=p_qsr , clinfo2=' p_qsr : ', kdim=ijpl) 601 CALL prt_ctl(tab3d_1=pst , clinfo1=' blk_ice_core: pst : ', tab3d_2=p_qns , clinfo2=' p_qns : ', kdim=ijpl) 602 CALL prt_ctl(tab2d_1=p_tpr , clinfo1=' blk_ice_core: p_tpr : ', tab2d_2=p_spr , clinfo2=' p_spr : ') 603 CALL prt_ctl(tab2d_1=p_taui , clinfo1=' blk_ice_core: p_taui : ', tab2d_2=p_tauj , clinfo2=' p_tauj : ') 604 CALL prt_ctl(tab2d_1=z_wnds_t, clinfo1=' blk_ice_core: z_wnds_t : ') 605 ENDIF 606 607 CALL wrk_dealloc( jpi,jpj, z_wnds_t ) 608 CALL wrk_dealloc( jpi,jpj, pdim, z_qlw, z_qsb, z_dqlw, z_dqsb ) 609 ! 610 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_core') 611 ! 612 END SUBROUTINE blk_ice_core 613 614 615 SUBROUTINE blk_bio_meanqsr 616 !!--------------------------------------------------------------------- 617 !! *** ROUTINE blk_bio_meanqsr 618 !! 619 !! ** Purpose : provide daily qsr_mean for PISCES when 620 !! analytic diurnal cycle is applied in physic 621 !! 622 !! ** Method : add part where there is no ice 623 !! 624 !!--------------------------------------------------------------------- 625 IF( nn_timing == 1 ) CALL timing_start('blk_bio_meanqsr') 626 ! 627 qsr_mean(:,:) = (1. - albo ) * sf(jp_qsr)%fnow(:,:,1) 628 ! 629 IF( nn_timing == 1 ) CALL timing_stop('blk_bio_meanqsr') 630 ! 631 END SUBROUTINE blk_bio_meanqsr 632 633 634 SUBROUTINE blk_ice_meanqsr( palb, p_qsr_mean, pdim ) 635 !!--------------------------------------------------------------------- 636 !! 637 !! ** Purpose : provide the daily qsr_mean over sea_ice for PISCES when 638 !! analytic diurnal cycle is applied in physic 639 !! 640 !! ** Method : compute qsr 641 !! 642 !!--------------------------------------------------------------------- 643 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb ! ice albedo (clear sky) (alb_ice_cs) [%] 644 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_qsr_mean ! solar heat flux over ice (T-point) [W/m2] 645 INTEGER , INTENT(in ) :: pdim ! number of ice categories 646 ! 647 INTEGER :: ijpl ! number of ice categories (size of 3rd dim of input arrays) 648 INTEGER :: ji, jj, jl ! dummy loop indices 649 REAL(wp) :: zztmp ! temporary variable 650 !!--------------------------------------------------------------------- 651 IF( nn_timing == 1 ) CALL timing_start('blk_ice_meanqsr') 652 ! 653 ijpl = pdim ! number of ice categories 654 zztmp = 1. / ( 1. - albo ) 655 ! ! ========================== ! 656 DO jl = 1, ijpl ! Loop over ice categories ! 657 ! ! ========================== ! 658 DO jj = 1 , jpj 659 DO ji = 1, jpi 660 p_qsr_mean(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr_mean(ji,jj) 661 END DO 662 END DO 663 END DO 664 ! 665 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_meanqsr') 666 ! 667 END SUBROUTINE blk_ice_meanqsr 668 648 CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice_core: qla_ice : ', tab3d_2=z_qsb , clinfo2=' z_qsb : ', kdim=jpl) 649 CALL prt_ctl(tab3d_1=z_qlw , clinfo1=' blk_ice_core: z_qlw : ', tab3d_2=dqla_ice, clinfo2=' dqla_ice : ', kdim=jpl) 650 CALL prt_ctl(tab3d_1=z_dqsb , clinfo1=' blk_ice_core: z_dqsb : ', tab3d_2=z_dqlw , clinfo2=' z_dqlw : ', kdim=jpl) 651 CALL prt_ctl(tab3d_1=dqns_ice, clinfo1=' blk_ice_core: dqns_ice : ', tab3d_2=qsr_ice , clinfo2=' qsr_ice : ', kdim=jpl) 652 CALL prt_ctl(tab3d_1=ptsu , clinfo1=' blk_ice_core: ptsu : ', tab3d_2=qns_ice , clinfo2=' qns_ice : ', kdim=jpl) 653 CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice_core: tprecip : ', tab2d_2=sprecip , clinfo2=' sprecip : ') 654 ENDIF 655 656 CALL wrk_dealloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 657 ! 658 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_core_flx') 659 660 END SUBROUTINE blk_ice_core_flx 661 #endif 669 662 670 663 SUBROUTINE turb_core_2z( zt, zu, sst, T_zt, q_sat, q_zt, dU, & -
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90
- Property svn:keywords set to Id
-
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5307 r5449 21 21 USE sbc_oce ! Surface boundary condition: ocean fields 22 22 USE sbc_ice ! Surface boundary condition: ice fields 23 USE sbcapr 23 24 USE sbcdcy ! surface boundary condition: diurnal cycle 24 25 USE phycst ! physical constants 25 26 #if defined key_lim3 26 USE par_ice ! ice parameters27 27 USE ice ! ice variables 28 28 #endif … … 33 33 USE cpl_oasis3 ! OASIS3 coupling 34 34 USE geo2ocean ! 35 USE oce , ONLY : tsn, un, vn 35 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 36 36 USE albedo ! 37 37 USE in_out_manager ! I/O manager … … 41 41 USE timing ! Timing 42 42 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 43 USE eosbn2 44 USE sbcrnf , ONLY : l_rnfcpl 43 45 #if defined key_cpl_carbon_cycle 44 46 USE p4zflx, ONLY : oce_co2 … … 47 49 USE ice_domain_size, only: ncat 48 50 #endif 51 #if defined key_lim3 52 USE limthd_dh ! for CALL lim_thd_snwblow 53 #endif 54 49 55 IMPLICIT NONE 50 56 PRIVATE 51 !EM XIOS-OASIS-MCT compliance 57 52 58 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 53 59 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90 … … 90 96 INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn 91 97 INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn 92 INTEGER, PARAMETER :: jprcv = 33 ! total number of fields received 93 94 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction 98 INTEGER, PARAMETER :: jpr_sflx = 34 ! salt flux 99 INTEGER, PARAMETER :: jpr_toce = 35 ! ocean temperature 100 INTEGER, PARAMETER :: jpr_soce = 36 ! ocean salinity 101 INTEGER, PARAMETER :: jpr_ocx1 = 37 ! ocean current on grid 1 102 INTEGER, PARAMETER :: jpr_ocy1 = 38 ! 103 INTEGER, PARAMETER :: jpr_ssh = 39 ! sea surface height 104 INTEGER, PARAMETER :: jpr_fice = 40 ! ice fraction 105 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 106 INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level 107 INTEGER, PARAMETER :: jprcv = 42 ! total number of fields received 108 109 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere 95 110 INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature 96 111 INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature … … 107 122 INTEGER, PARAMETER :: jps_ivz1 = 14 ! 108 123 INTEGER, PARAMETER :: jps_co2 = 15 109 INTEGER, PARAMETER :: jpsnd = 15 ! total number of fields sended 124 INTEGER, PARAMETER :: jps_soce = 16 ! ocean salinity 125 INTEGER, PARAMETER :: jps_ssh = 17 ! sea surface height 126 INTEGER, PARAMETER :: jps_qsroce = 18 ! Qsr above the ocean 127 INTEGER, PARAMETER :: jps_qnsoce = 19 ! Qns above the ocean 128 INTEGER, PARAMETER :: jps_oemp = 20 ! ocean freshwater budget (evap - precip) 129 INTEGER, PARAMETER :: jps_sflx = 21 ! salt flux 130 INTEGER, PARAMETER :: jps_otx1 = 22 ! 2 atmosphere-ocean stress components on grid 1 131 INTEGER, PARAMETER :: jps_oty1 = 23 ! 132 INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs 133 INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module 134 INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling) 135 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 136 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level 137 INTEGER, PARAMETER :: jpsnd = 28 ! total number of fields sended 110 138 111 139 ! !!** namelist namsbc_cpl ** … … 126 154 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 127 155 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 128 129 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask130 131 156 TYPE :: DYNARR 132 157 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 … … 140 165 141 166 !! Substitution 167 # include "domzgr_substitute.h90" 142 168 # include "vectopt_loop_substitute.h90" 143 169 !!---------------------------------------------------------------------- … … 162 188 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 163 189 #endif 164 ALLOCATE( xcplmask(jpi,jpj, nn_cplmodel) , STAT=ierr(3) )190 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 165 191 ! 166 192 sbc_cpl_alloc = MAXVAL( ierr ) … … 183 209 !! * initialise the OASIS coupler 184 210 !!---------------------------------------------------------------------- 185 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)211 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 186 212 !! 187 213 INTEGER :: jn ! dummy loop index … … 217 243 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 218 244 WRITE(numout,*)'~~~~~~~~~~~~' 245 ENDIF 246 IF( lwp .AND. ln_cpl ) THEN ! control print 219 247 WRITE(numout,*)' received fields (mutiple ice categogies)' 220 248 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' … … 360 388 srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip 361 389 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 390 CASE( 'none' ) ! nothing to do 362 391 CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE. 363 392 CASE( 'conservative' ) … … 371 400 ! ! Runoffs & Calving ! 372 401 ! ! ------------------------- ! 373 srcv(jpr_rnf )%clname = 'O_Runoff' ; IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 374 ! This isn't right - really just want ln_rnf_emp changed 375 ! IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' ) THEN ; ln_rnf = .TRUE. 376 ! ELSE ; ln_rnf = .FALSE. 377 ! ENDIF 402 srcv(jpr_rnf )%clname = 'O_Runoff' 403 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 404 srcv(jpr_rnf)%laction = .TRUE. 405 l_rnfcpl = .TRUE. ! -> no need to read runoffs in sbcrnf 406 ln_rnf = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas 407 IF(lwp) WRITE(numout,*) 408 IF(lwp) WRITE(numout,*) ' runoffs received from oasis -> force ln_rnf = ', ln_rnf 409 ENDIF 410 ! 378 411 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 379 412 … … 385 418 srcv(jpr_qnsmix)%clname = 'O_QnsMix' 386 419 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 420 CASE( 'none' ) ! nothing to do 387 421 CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE. 388 422 CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. … … 400 434 srcv(jpr_qsrmix)%clname = 'O_QsrMix' 401 435 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 436 CASE( 'none' ) ! nothing to do 402 437 CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE. 403 438 CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. … … 415 450 ! 416 451 ! non solar sensitivity mandatory for LIM ice model 417 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 ) &452 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) & 418 453 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 419 454 ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique … … 448 483 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 449 484 ENDIF 450 451 ! Allocate all parts of frcv used for received fields 485 ! ! ------------------------------- ! 486 ! ! OPA-SAS coupling - rcv by opa ! 487 ! ! ------------------------------- ! 488 srcv(jpr_sflx)%clname = 'O_SFLX' 489 srcv(jpr_fice)%clname = 'RIceFrc' 490 ! 491 IF( nn_components == jp_iam_opa ) THEN ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS) 492 srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 493 srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling 494 srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling 495 srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE. 496 srcv(jpr_otx1)%clgrid = 'U' ! oce components given at U-point 497 srcv(jpr_oty1)%clgrid = 'V' ! and V-point 498 ! Vectors: change of sign at north fold ONLY if on the local grid 499 srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1. 500 sn_rcv_tau%clvgrd = 'U,V' 501 sn_rcv_tau%clvor = 'local grid' 502 sn_rcv_tau%clvref = 'spherical' 503 sn_rcv_emp%cldes = 'oce only' 504 ! 505 IF(lwp) THEN ! control print 506 WRITE(numout,*) 507 WRITE(numout,*)' Special conditions for SAS-OPA coupling ' 508 WRITE(numout,*)' OPA component ' 509 WRITE(numout,*) 510 WRITE(numout,*)' received fields from SAS component ' 511 WRITE(numout,*)' ice cover ' 512 WRITE(numout,*)' oce only EMP ' 513 WRITE(numout,*)' salt flux ' 514 WRITE(numout,*)' mixed oce-ice solar flux ' 515 WRITE(numout,*)' mixed oce-ice non solar flux ' 516 WRITE(numout,*)' wind stress U,V on local grid and sperical coordinates ' 517 WRITE(numout,*)' wind stress module' 518 WRITE(numout,*) 519 ENDIF 520 ENDIF 521 ! ! -------------------------------- ! 522 ! ! OPA-SAS coupling - rcv by sas ! 523 ! ! -------------------------------- ! 524 srcv(jpr_toce )%clname = 'I_SSTSST' 525 srcv(jpr_soce )%clname = 'I_SSSal' 526 srcv(jpr_ocx1 )%clname = 'I_OCurx1' 527 srcv(jpr_ocy1 )%clname = 'I_OCury1' 528 srcv(jpr_ssh )%clname = 'I_SSHght' 529 srcv(jpr_e3t1st)%clname = 'I_E3T1st' 530 srcv(jpr_fraqsr)%clname = 'I_FraQsr' 531 ! 532 IF( nn_components == jp_iam_sas ) THEN 533 IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 534 IF( .NOT. ln_cpl ) srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling 535 IF( .NOT. ln_cpl ) srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling 536 srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE. 537 srcv( jpr_e3t1st )%laction = lk_vvl 538 srcv(jpr_ocx1)%clgrid = 'U' ! oce components given at U-point 539 srcv(jpr_ocy1)%clgrid = 'V' ! and V-point 540 ! Vectors: change of sign at north fold ONLY if on the local grid 541 srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1. 542 ! Change first letter to couple with atmosphere if already coupled OPA 543 ! this is nedeed as each variable name used in the namcouple must be unique: 544 ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere 545 DO jn = 1, jprcv 546 IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 547 END DO 548 ! 549 IF(lwp) THEN ! control print 550 WRITE(numout,*) 551 WRITE(numout,*)' Special conditions for SAS-OPA coupling ' 552 WRITE(numout,*)' SAS component ' 553 WRITE(numout,*) 554 IF( .NOT. ln_cpl ) THEN 555 WRITE(numout,*)' received fields from OPA component ' 556 ELSE 557 WRITE(numout,*)' Additional received fields from OPA component : ' 558 ENDIF 559 WRITE(numout,*)' sea surface temperature (Celcius) ' 560 WRITE(numout,*)' sea surface salinity ' 561 WRITE(numout,*)' surface currents ' 562 WRITE(numout,*)' sea surface height ' 563 WRITE(numout,*)' thickness of first ocean T level ' 564 WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level' 565 WRITE(numout,*) 566 ENDIF 567 ENDIF 568 569 ! =================================================== ! 570 ! Allocate all parts of frcv used for received fields ! 571 ! =================================================== ! 452 572 DO jn = 1, jprcv 453 573 IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) … … 455 575 ! Allocate taum part of frcv which is used even when not received as coupling field 456 576 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 577 ! Allocate w10m part of frcv which is used even when not received as coupling field 578 IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 579 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 580 IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 581 IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 457 582 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 458 583 IF( k_ice /= 0 ) THEN … … 478 603 ssnd(jps_tmix)%clname = 'O_TepMix' 479 604 SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 480 CASE( 'none' ) ! nothing to do481 CASE( 'oce only' ) ; ssnd( jps_toce)%laction = .TRUE.482 CASE( ' weighted oce and ice' )605 CASE( 'none' ) ! nothing to do 606 CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE. 607 CASE( 'oce and ice' , 'weighted oce and ice' ) 483 608 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 484 609 IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl 485 CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix)%laction = .TRUE.610 CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE. 486 611 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 487 612 END SELECT 488 613 489 614 ! ! ------------------------- ! 490 615 ! ! Albedo ! … … 493 618 ssnd(jps_albmix)%clname = 'O_AlbMix' 494 619 SELECT CASE( TRIM( sn_snd_alb%cldes ) ) 495 CASE( 'none' )! nothing to do496 CASE( ' weighted ice' ) ;ssnd(jps_albice)%laction = .TRUE.497 CASE( 'mixed oce-ice' ) ;ssnd(jps_albmix)%laction = .TRUE.620 CASE( 'none' ) ! nothing to do 621 CASE( 'ice' , 'weighted ice' ) ; ssnd(jps_albice)%laction = .TRUE. 622 CASE( 'mixed oce-ice' ) ; ssnd(jps_albmix)%laction = .TRUE. 498 623 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' ) 499 624 END SELECT … … 519 644 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 520 645 ENDIF 521 646 522 647 SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 523 648 CASE( 'none' ) ! nothing to do … … 526 651 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 527 652 ssnd(jps_hice:jps_hsnw)%nct = jpl 528 ELSE529 IF ( jpl > 1 ) THEN530 CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' )531 ENDIF532 653 ENDIF 533 654 CASE ( 'weighted ice and snow' ) … … 568 689 ! ! ------------------------- ! 569 690 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 691 692 ! ! ------------------------------- ! 693 ! ! OPA-SAS coupling - snd by opa ! 694 ! ! ------------------------------- ! 695 ssnd(jps_ssh )%clname = 'O_SSHght' 696 ssnd(jps_soce )%clname = 'O_SSSal' 697 ssnd(jps_e3t1st)%clname = 'O_E3T1st' 698 ssnd(jps_fraqsr)%clname = 'O_FraQsr' 699 ! 700 IF( nn_components == jp_iam_opa ) THEN 701 ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 702 ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE. 703 ssnd( jps_e3t1st )%laction = lk_vvl 704 ! vector definition: not used but cleaner... 705 ssnd(jps_ocx1)%clgrid = 'U' ! oce components given at U-point 706 ssnd(jps_ocy1)%clgrid = 'V' ! and V-point 707 sn_snd_crt%clvgrd = 'U,V' 708 sn_snd_crt%clvor = 'local grid' 709 sn_snd_crt%clvref = 'spherical' 710 ! 711 IF(lwp) THEN ! control print 712 WRITE(numout,*) 713 WRITE(numout,*)' sent fields to SAS component ' 714 WRITE(numout,*)' sea surface temperature (T before, Celcius) ' 715 WRITE(numout,*)' sea surface salinity ' 716 WRITE(numout,*)' surface currents U,V on local grid and spherical coordinates' 717 WRITE(numout,*)' sea surface height ' 718 WRITE(numout,*)' thickness of first ocean T level ' 719 WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level' 720 WRITE(numout,*) 721 ENDIF 722 ENDIF 723 ! ! ------------------------------- ! 724 ! ! OPA-SAS coupling - snd by sas ! 725 ! ! ------------------------------- ! 726 ssnd(jps_sflx )%clname = 'I_SFLX' 727 ssnd(jps_fice2 )%clname = 'IIceFrc' 728 ssnd(jps_qsroce)%clname = 'I_QsrOce' 729 ssnd(jps_qnsoce)%clname = 'I_QnsOce' 730 ssnd(jps_oemp )%clname = 'IOEvaMPr' 731 ssnd(jps_otx1 )%clname = 'I_OTaux1' 732 ssnd(jps_oty1 )%clname = 'I_OTauy1' 733 ssnd(jps_rnf )%clname = 'I_Runoff' 734 ssnd(jps_taum )%clname = 'I_TauMod' 735 ! 736 IF( nn_components == jp_iam_sas ) THEN 737 IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 738 ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE. 739 ! 740 ! Change first letter to couple with atmosphere if already coupled with sea_ice 741 ! this is nedeed as each variable name used in the namcouple must be unique: 742 ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 743 DO jn = 1, jpsnd 744 IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 745 END DO 746 ! 747 IF(lwp) THEN ! control print 748 WRITE(numout,*) 749 IF( .NOT. ln_cpl ) THEN 750 WRITE(numout,*)' sent fields to OPA component ' 751 ELSE 752 WRITE(numout,*)' Additional sent fields to OPA component : ' 753 ENDIF 754 WRITE(numout,*)' ice cover ' 755 WRITE(numout,*)' oce only EMP ' 756 WRITE(numout,*)' salt flux ' 757 WRITE(numout,*)' mixed oce-ice solar flux ' 758 WRITE(numout,*)' mixed oce-ice non solar flux ' 759 WRITE(numout,*)' wind stress U,V components' 760 WRITE(numout,*)' wind stress module' 761 ENDIF 762 ENDIF 763 570 764 ! 571 765 ! ================================ ! … … 573 767 ! ================================ ! 574 768 575 CALL cpl_define(jprcv, jpsnd,nn_cplmodel) 769 CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 770 576 771 IF (ln_usecplmask) THEN 577 772 xcplmask(:,:,:) = 0. … … 583 778 xcplmask(:,:,:) = 1. 584 779 ENDIF 585 ! 586 IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) ) & 780 xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 781 ! 782 ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'S_QsrOce' ) + cpl_freq( 'S_QsrMix' ) 783 IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 ) & 587 784 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 785 ncpl_qsr_freq = 86400 / ncpl_qsr_freq 588 786 589 787 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) … … 639 837 !! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 640 838 !!---------------------------------------------------------------------- 641 INTEGER, INTENT(in) :: kt ! ocean model time step index 642 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 643 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 644 !! 645 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 839 INTEGER, INTENT(in) :: kt ! ocean model time step index 840 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 841 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 842 843 !! 844 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 646 845 INTEGER :: ji, jj, jn ! dummy loop indices 647 846 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) … … 651 850 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 652 851 REAL(wp) :: zzx, zzy ! temporary variables 653 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty 852 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr 654 853 !!---------------------------------------------------------------------- 655 854 ! 656 855 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 657 856 ! 658 CALL wrk_alloc( jpi,jpj, ztx, zty ) 659 ! ! Receive all the atmos. fields (including ice information) 660 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 661 DO jn = 1, jprcv ! received fields sent by the atmosphere 662 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) ) 857 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 858 ! 859 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 860 ! 861 ! ! ======================================================= ! 862 ! ! Receive all the atmos. fields (including ice information) 863 ! ! ======================================================= ! 864 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 865 DO jn = 1, jprcv ! received fields sent by the atmosphere 866 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 663 867 END DO 664 868 … … 720 924 ! 721 925 ENDIF 722 723 926 ! ! ========================= ! 724 927 ! ! wind stress module ! (taum) … … 749 952 ENDIF 750 953 ENDIF 751 954 ! 752 955 ! ! ========================= ! 753 956 ! ! 10 m wind speed ! (wndm) … … 762 965 !CDIR NOVERRCHK 763 966 DO ji = 1, jpi 764 wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )967 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 765 968 END DO 766 969 END DO 767 970 ENDIF 768 ELSE769 IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)770 971 ENDIF 771 972 … … 774 975 IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 775 976 ! 776 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 777 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 778 taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 977 IF( ln_mixcpl ) THEN 978 utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:) 979 vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:) 980 taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:) 981 wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:) 982 ELSE 983 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 984 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 985 taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 986 wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 987 ENDIF 779 988 CALL iom_put( "taum_oce", taum ) ! output wind stress module 780 989 ! … … 782 991 783 992 #if defined key_cpl_carbon_cycle 784 ! ! atmosph. CO2 (ppm) 993 ! ! ================== ! 994 ! ! atmosph. CO2 (ppm) ! 995 ! ! ================== ! 785 996 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 786 997 #endif 787 998 999 ! Fields received by SAS when OASIS coupling 1000 ! (arrays no more filled at sbcssm stage) 1001 ! ! ================== ! 1002 ! ! SSS ! 1003 ! ! ================== ! 1004 IF( srcv(jpr_soce)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1005 sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1) 1006 CALL iom_put( 'sss_m', sss_m ) 1007 ENDIF 1008 ! 1009 ! ! ================== ! 1010 ! ! SST ! 1011 ! ! ================== ! 1012 IF( srcv(jpr_toce)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1013 sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1) 1014 IF( srcv(jpr_soce)%laction .AND. ln_useCT ) THEN ! make sure that sst_m is the potential temperature 1015 sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) ) 1016 ENDIF 1017 ENDIF 1018 ! ! ================== ! 1019 ! ! SSH ! 1020 ! ! ================== ! 1021 IF( srcv(jpr_ssh )%laction ) THEN ! received by sas in case of opa <-> sas coupling 1022 ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1) 1023 CALL iom_put( 'ssh_m', ssh_m ) 1024 ENDIF 1025 ! ! ================== ! 1026 ! ! surface currents ! 1027 ! ! ================== ! 1028 IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1029 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1030 ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1031 CALL iom_put( 'ssu_m', ssu_m ) 1032 ENDIF 1033 IF( srcv(jpr_ocy1)%laction ) THEN 1034 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1035 vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1036 CALL iom_put( 'ssv_m', ssv_m ) 1037 ENDIF 1038 ! ! ======================== ! 1039 ! ! first T level thickness ! 1040 ! ! ======================== ! 1041 IF( srcv(jpr_e3t1st )%laction ) THEN ! received by sas in case of opa <-> sas coupling 1042 e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1) 1043 CALL iom_put( 'e3t_m', e3t_m(:,:) ) 1044 ENDIF 1045 ! ! ================================ ! 1046 ! ! fraction of solar net radiation ! 1047 ! ! ================================ ! 1048 IF( srcv(jpr_fraqsr)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1049 frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1) 1050 CALL iom_put( 'frq_m', frq_m ) 1051 ENDIF 1052 788 1053 ! ! ========================= ! 789 IF( k_ice <= 1 ) THEN! heat & freshwater fluxes ! (Ocean only case)1054 IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN ! heat & freshwater fluxes ! (Ocean only case) 790 1055 ! ! ========================= ! 791 1056 ! 792 1057 ! ! total freshwater fluxes over the ocean (emp) 793 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 794 CASE( 'conservative' ) 795 emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 796 CASE( 'oce only', 'oce and ice' ) 797 emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 798 CASE default 799 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 800 END SELECT 1058 IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN 1059 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 1060 CASE( 'conservative' ) 1061 zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 1062 CASE( 'oce only', 'oce and ice' ) 1063 zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 1064 CASE default 1065 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 1066 END SELECT 1067 ELSE 1068 zemp(:,:) = 0._wp 1069 ENDIF 801 1070 ! 802 1071 ! ! runoffs and calving (added in emp) 803 IF( srcv(jpr_rnf)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 804 IF( srcv(jpr_cal)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 805 ! 806 !!gm : this seems to be internal cooking, not sure to need that in a generic interface 807 !!gm at least should be optional... 808 !! IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN ! add to the total freshwater budget 809 !! ! remove negative runoff 810 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 811 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 812 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) ! sum over the global domain 813 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 814 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 815 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 816 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 817 !! ENDIF 818 !! ! add runoff to e-p 819 !! emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 820 !! ENDIF 821 !!gm end of internal cooking 1072 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1073 IF( srcv(jpr_cal)%laction ) zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 1074 1075 IF( ln_mixcpl ) THEN ; emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 1076 ELSE ; emp(:,:) = zemp(:,:) 1077 ENDIF 822 1078 ! 823 1079 ! ! non solar heat flux over the ocean (qns) 824 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 825 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1080 IF( srcv(jpr_qnsoce)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1081 ELSE IF( srcv(jpr_qnsmix)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1082 ELSE ; zqns(:,:) = 0._wp 1083 END IF 826 1084 ! update qns over the free ocean with: 827 qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 828 IF( srcv(jpr_snow )%laction ) THEN 829 qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean 1085 IF( nn_components /= jp_iam_opa ) THEN 1086 zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 1087 IF( srcv(jpr_snow )%laction ) THEN 1088 zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean 1089 ENDIF 1090 ENDIF 1091 IF( ln_mixcpl ) THEN ; qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) 1092 ELSE ; qns(:,:) = zqns(:,:) 830 1093 ENDIF 831 1094 832 1095 ! ! solar flux over the ocean (qsr) 833 IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 834 IF( srcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 835 IF( ln_dm2dc ) qsr(:,:) = sbc_dcy( qsr ) ! modify qsr to include the diurnal cycle 1096 IF ( srcv(jpr_qsroce)%laction ) THEN ; zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 1097 ELSE IF( srcv(jpr_qsrmix)%laction ) then ; zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 1098 ELSE ; zqsr(:,:) = 0._wp 1099 ENDIF 1100 IF( ln_dm2dc .AND. ln_cpl ) zqsr(:,:) = sbc_dcy( zqsr ) ! modify qsr to include the diurnal cycle 1101 IF( ln_mixcpl ) THEN ; qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:) 1102 ELSE ; qsr(:,:) = zqsr(:,:) 1103 ENDIF 836 1104 ! 837 838 ENDIF 839 ! 840 CALL wrk_dealloc( jpi,jpj, ztx, zty ) 1105 ! salt flux over the ocean (received by opa in case of opa <-> sas coupling) 1106 IF( srcv(jpr_sflx )%laction ) sfx(:,:) = frcv(jpr_sflx )%z3(:,:,1) 1107 ! Ice cover (received by opa in case of opa <-> sas coupling) 1108 IF( srcv(jpr_fice )%laction ) fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 1109 ! 1110 1111 ENDIF 1112 ! 1113 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 841 1114 ! 842 1115 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') … … 935 1208 ! 936 1209 ENDIF 937 938 1210 ! ! ======================= ! 939 1211 ! ! put on ice grid ! … … 1057 1329 1058 1330 1059 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist)1331 SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist ) 1060 1332 !!---------------------------------------------------------------------- 1061 1333 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1099 1371 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1100 1372 ! optional arguments, used only in 'mixed oce-ice' case 1101 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1102 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1103 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1104 ! 1105 INTEGER :: jl ! dummy loop index 1106 REAL(wp), POINTER, DIMENSION(:,:) :: zcptn, ztmp, zicefr 1373 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1374 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1375 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1376 ! 1377 INTEGER :: jl ! dummy loop index 1378 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk 1379 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot 1380 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice 1381 REAL(wp), POINTER, DIMENSION(:,: ) :: zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ! for LIM3 1107 1382 !!---------------------------------------------------------------------- 1108 1383 ! 1109 1384 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1110 1385 ! 1111 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr ) 1112 1386 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1387 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1388 1389 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 1113 1390 zicefr(:,:) = 1.- p_frld(:,:) 1114 1391 zcptn(:,:) = rcp * sst_m(:,:) … … 1118 1395 ! ! ========================= ! 1119 1396 ! 1120 ! ! total Precipitations - total Evaporation (emp_tot) 1121 ! ! solid precipitation - sublimation (emp_ice) 1122 ! ! solid Precipitation (sprecip) 1397 ! ! total Precipitation - total Evaporation (emp_tot) 1398 ! ! solid precipitation - sublimation (emp_ice) 1399 ! ! solid Precipitation (sprecip) 1400 ! ! liquid + solid Precipitation (tprecip) 1123 1401 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1124 1402 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1125 sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)! May need to ensure positive here1126 tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:)! May need to ensure positive here1127 emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) -tprecip(:,:)1128 emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)1403 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1404 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1405 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1406 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1129 1407 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1130 1408 IF( iom_use('hflx_rain_cea') ) & … … 1137 1415 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) ) ! heat flux from from evap (cell average) 1138 1416 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1139 emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1140 emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1141 sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 1417 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1418 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1419 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1420 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 1142 1421 END SELECT 1422 1423 IF( iom_use('subl_ai_cea') ) & 1424 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1425 ! 1426 ! ! runoffs and calving (put in emp_tot) 1427 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1428 IF( srcv(jpr_cal)%laction ) THEN 1429 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1430 CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 1431 ENDIF 1432 1433 IF( ln_mixcpl ) THEN 1434 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1435 emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1436 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1437 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1438 ELSE 1439 emp_tot(:,:) = zemp_tot(:,:) 1440 emp_ice(:,:) = zemp_ice(:,:) 1441 sprecip(:,:) = zsprecip(:,:) 1442 tprecip(:,:) = ztprecip(:,:) 1443 ENDIF 1143 1444 1144 1445 CALL iom_put( 'snowpre' , sprecip ) ! Snow … … 1147 1448 IF( iom_use('snow_ai_cea') ) & 1148 1449 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1149 IF( iom_use('subl_ai_cea') ) &1150 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average)1151 !1152 ! ! runoffs and calving (put in emp_tot)1153 IF( srcv(jpr_rnf)%laction ) THEN1154 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)1155 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers1156 IF( iom_use('hflx_rnf_cea') ) &1157 CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers1158 ENDIF1159 IF( srcv(jpr_cal)%laction ) THEN1160 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)1161 CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) )1162 ENDIF1163 !1164 !!gm : this seems to be internal cooking, not sure to need that in a generic interface1165 !!gm at least should be optional...1166 !! ! remove negative runoff ! sum over the global domain1167 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1168 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1169 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos )1170 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg )1171 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points1172 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos1173 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg1174 !! ENDIF1175 !! emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) ! add runoff to e-p1176 !!1177 !!gm end of internal cooking1178 1450 1179 1451 ! ! ========================= ! … … 1181 1453 ! ! ========================= ! 1182 1454 CASE( 'oce only' ) ! the required field is directly provided 1183 qns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1)1455 zqns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1) 1184 1456 CASE( 'conservative' ) ! the required fields are directly provided 1185 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)1457 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1186 1458 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1187 qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)1459 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1188 1460 ELSE 1189 1461 ! Set all category values equal for the moment 1190 1462 DO jl=1,jpl 1191 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)1463 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1192 1464 ENDDO 1193 1465 ENDIF 1194 1466 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1195 qns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)1467 zqns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1196 1468 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1197 1469 DO jl=1,jpl 1198 qns_tot(:,: ) =qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)1199 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)1470 zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) 1471 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 1200 1472 ENDDO 1201 1473 ELSE 1474 qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1202 1475 DO jl=1,jpl 1203 qns_tot(:,: ) =qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1204 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)1476 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1477 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1205 1478 ENDDO 1206 1479 ENDIF 1207 1480 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1208 1481 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1209 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)1210 qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) &1482 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1483 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1211 1484 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1212 1485 & + pist(:,:,1) * zicefr(:,:) ) ) 1213 1486 END SELECT 1214 ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus1215 qns_tot(:,:) = qns_tot(:,:) & ! qns_tot update over free ocean with:1216 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting1217 & - ( emp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST)1218 & - emp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:)1219 IF( iom_use('hflx_snow_cea') ) &1220 CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average)1221 1487 !!gm 1222 !! currently it is taken into account in leads budget but not in the qns_tot, and thus not in1488 !! currently it is taken into account in leads budget but not in the zqns_tot, and thus not in 1223 1489 !! the flux that enter the ocean.... 1224 1490 !! moreover 1 - it is not diagnose anywhere.... … … 1229 1495 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1230 1496 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1231 qns_tot(:,:) =qns_tot(:,:) - ztmp(:,:)1497 zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 1232 1498 IF( iom_use('hflx_cal_cea') ) & 1233 1499 CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1234 1500 ENDIF 1501 1502 ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 1503 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1504 1505 #if defined key_lim3 1506 CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1507 1508 ! --- evaporation --- ! 1509 ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation 1510 ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice 1511 ! but it is incoherent WITH the ice model 1512 DO jl=1,jpl 1513 evap_ice(:,:,jl) = 0._wp ! should be: frcv(jpr_ievp)%z3(:,:,1) 1514 ENDDO 1515 zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 1516 1517 ! --- evaporation minus precipitation --- ! 1518 emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:) 1519 1520 ! --- non solar flux over ocean --- ! 1521 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax 1522 zqns_oce = 0._wp 1523 WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 1524 1525 ! --- heat flux associated with emp --- ! 1526 CALL lim_thd_snwblow( p_frld, zsnw ) ! snow distribution over ice after wind blowing 1527 zqemp_oce(:,:) = - zevap(:,:) * p_frld(:,:) * zcptn(:,:) & ! evap 1528 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip 1529 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 1530 qemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1531 & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1532 1533 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1534 zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 1535 1536 ! --- total non solar flux --- ! 1537 zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:) 1538 1539 ! --- in case both coupled/forced are active, we must mix values --- ! 1540 IF( ln_mixcpl ) THEN 1541 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 1542 qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:) 1543 DO jl=1,jpl 1544 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1545 ENDDO 1546 qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:) 1547 qemp_oce (:,:) = qemp_oce(:,:) * xcplmask(:,:,0) + zqemp_oce(:,:)* zmsk(:,:) 1548 !!clem evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0) 1549 ELSE 1550 qns_tot (:,: ) = zqns_tot (:,: ) 1551 qns_oce (:,: ) = zqns_oce (:,: ) 1552 qns_ice (:,:,:) = zqns_ice (:,:,:) 1553 qprec_ice(:,:) = zqprec_ice(:,:) 1554 qemp_oce (:,:) = zqemp_oce (:,:) 1555 ENDIF 1556 1557 CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1558 1559 #else 1560 1561 ! clem: this formulation is certainly wrong... but better than it was... 1562 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1563 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting 1564 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1565 & - zemp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:) 1566 1567 IF( ln_mixcpl ) THEN 1568 qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1569 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 1570 DO jl=1,jpl 1571 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1572 ENDDO 1573 ELSE 1574 qns_tot(:,: ) = zqns_tot(:,: ) 1575 qns_ice(:,:,:) = zqns_ice(:,:,:) 1576 ENDIF 1577 1578 #endif 1235 1579 1236 1580 ! ! ========================= ! … … 1238 1582 ! ! ========================= ! 1239 1583 CASE( 'oce only' ) 1240 qsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )1584 zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 1241 1585 CASE( 'conservative' ) 1242 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1586 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1243 1587 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1244 qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)1588 zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 1245 1589 ELSE 1246 1590 ! Set all category values equal for the moment 1247 1591 DO jl=1,jpl 1248 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)1592 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1249 1593 ENDDO 1250 1594 ENDIF 1251 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1252 qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)1595 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1596 zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1253 1597 CASE( 'oce and ice' ) 1254 qsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)1598 zqsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1255 1599 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1256 1600 DO jl=1,jpl 1257 qsr_tot(:,: ) =qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)1258 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)1601 zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) 1602 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 1259 1603 ENDDO 1260 1604 ELSE 1605 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1261 1606 DO jl=1,jpl 1262 qsr_tot(:,: ) =qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1263 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)1607 zqsr_tot(:,: ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1608 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1264 1609 ENDDO 1265 1610 ENDIF 1266 1611 CASE( 'mixed oce-ice' ) 1267 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1612 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1268 1613 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1269 1614 ! Create solar heat flux over ice using incoming solar heat flux and albedos 1270 1615 ! ( see OASIS3 user guide, 5th edition, p39 ) 1271 qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) &1616 zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1272 1617 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) & 1273 1618 & + palbi (:,:,1) * zicefr(:,:) ) ) 1274 1619 END SELECT 1275 IF( ln_dm2dc ) THEN ! modify qsr to include the diurnal cycle1276 qsr_tot(:,: ) = sbc_dcy(qsr_tot(:,: ) )1620 IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle 1621 zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) ) 1277 1622 DO jl=1,jpl 1278 qsr_ice(:,:,jl) = sbc_dcy(qsr_ice(:,:,jl) )1623 zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) ) 1279 1624 ENDDO 1625 ENDIF 1626 1627 IF( ln_mixcpl ) THEN 1628 qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1629 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:) 1630 DO jl=1,jpl 1631 qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:) 1632 ENDDO 1633 ELSE 1634 qsr_tot(:,: ) = zqsr_tot(:,: ) 1635 qsr_ice(:,:,:) = zqsr_ice(:,:,:) 1280 1636 ENDIF 1281 1637 … … 1285 1641 CASE ('coupled') 1286 1642 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 1287 dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)1643 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 1288 1644 ELSE 1289 1645 ! Set all category values equal for the moment 1290 1646 DO jl=1,jpl 1291 dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)1647 zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 1292 1648 ENDDO 1293 1649 ENDIF 1294 1650 END SELECT 1295 1651 1652 IF( ln_mixcpl ) THEN 1653 DO jl=1,jpl 1654 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:) 1655 ENDDO 1656 ELSE 1657 dqns_ice(:,:,:) = zdqns_ice(:,:,:) 1658 ENDIF 1659 1296 1660 ! ! ========================= ! 1297 1661 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt ! … … 1309 1673 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1310 1674 1311 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) 1675 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1676 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1312 1677 ! 1313 1678 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') … … 1329 1694 INTEGER :: ji, jj, jl ! dummy loop indices 1330 1695 INTEGER :: isec, info ! local integer 1696 REAL(wp) :: zumax, zvmax 1331 1697 REAL(wp), POINTER, DIMENSION(:,:) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 1332 1698 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp3, ztmp4 … … 1345 1711 ! ! ------------------------- ! 1346 1712 IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 1347 SELECT CASE( sn_snd_temp%cldes) 1348 CASE( 'oce only' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 1349 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1350 SELECT CASE( sn_snd_temp%clcat ) 1351 CASE( 'yes' ) 1352 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1353 CASE( 'no' ) 1354 ztmp3(:,:,:) = 0.0 1713 1714 IF ( nn_components == jp_iam_opa ) THEN 1715 ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part 1716 ELSE 1717 ! we must send the surface potential temperature 1718 IF( ln_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 1719 ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem) 1720 ENDIF 1721 ! 1722 SELECT CASE( sn_snd_temp%cldes) 1723 CASE( 'oce only' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0 1724 CASE( 'oce and ice' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0 1725 SELECT CASE( sn_snd_temp%clcat ) 1726 CASE( 'yes' ) 1727 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) 1728 CASE( 'no' ) 1729 WHERE( SUM( a_i, dim=3 ) /= 0. ) 1730 ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1731 ELSEWHERE 1732 ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?) 1733 END WHERE 1734 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1735 END SELECT 1736 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 1737 SELECT CASE( sn_snd_temp%clcat ) 1738 CASE( 'yes' ) 1739 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1740 CASE( 'no' ) 1741 ztmp3(:,:,:) = 0.0 1742 DO jl=1,jpl 1743 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 1744 ENDDO 1745 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1746 END SELECT 1747 CASE( 'mixed oce-ice' ) 1748 ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 1355 1749 DO jl=1,jpl 1356 ztmp 3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)1750 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1357 1751 ENDDO 1358 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )1752 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1359 1753 END SELECT 1360 CASE( 'mixed oce-ice' ) 1361 ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1362 DO jl=1,jpl 1363 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1364 ENDDO 1365 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1366 END SELECT 1754 ENDIF 1367 1755 IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1368 1756 IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info ) … … 1373 1761 ! ! ------------------------- ! 1374 1762 IF( ssnd(jps_albice)%laction ) THEN ! ice 1375 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1763 SELECT CASE( sn_snd_alb%cldes ) 1764 CASE( 'ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 1765 CASE( 'weighted ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1766 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 1767 END SELECT 1376 1768 CALL cpl_snd( jps_albice, isec, ztmp3, info ) 1377 1769 ENDIF … … 1386 1778 ! ! Ice fraction & Thickness ! 1387 1779 ! ! ------------------------- ! 1388 ! Send ice fraction field 1780 ! Send ice fraction field to atmosphere 1389 1781 IF( ssnd(jps_fice)%laction ) THEN 1390 1782 SELECT CASE( sn_snd_thick%clcat ) … … 1393 1785 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1394 1786 END SELECT 1395 CALL cpl_snd( jps_fice, isec, ztmp3, info ) 1787 IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info ) 1788 ENDIF 1789 1790 ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling) 1791 IF( ssnd(jps_fice2)%laction ) THEN 1792 ztmp3(:,:,1) = fr_i(:,:) 1793 IF( ssnd(jps_fice2)%laction ) CALL cpl_snd( jps_fice2, isec, ztmp3, info ) 1396 1794 ENDIF 1397 1795 … … 1414 1812 END SELECT 1415 1813 CASE( 'ice and snow' ) 1416 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 1417 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 1814 SELECT CASE( sn_snd_thick%clcat ) 1815 CASE( 'yes' ) 1816 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 1817 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 1818 CASE( 'no' ) 1819 WHERE( SUM( a_i, dim=3 ) /= 0. ) 1820 ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1821 ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1822 ELSEWHERE 1823 ztmp3(:,:,1) = 0. 1824 ztmp4(:,:,1) = 0. 1825 END WHERE 1826 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1827 END SELECT 1418 1828 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 1419 1829 END SELECT … … 1441 1851 ! i-1 i i 1442 1852 ! i i+1 (for I) 1443 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1444 CASE( 'oce only' ) ! C-grid ==> T 1445 DO jj = 2, jpjm1 1446 DO ji = fs_2, fs_jpim1 ! vector opt. 1447 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1448 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1449 END DO 1450 END DO 1451 CASE( 'weighted oce and ice' ) 1452 SELECT CASE ( cp_ice_msh ) 1453 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1853 IF( nn_components == jp_iam_opa ) THEN 1854 zotx1(:,:) = un(:,:,1) 1855 zoty1(:,:) = vn(:,:,1) 1856 ELSE 1857 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1858 CASE( 'oce only' ) ! C-grid ==> T 1454 1859 DO jj = 2, jpjm1 1455 1860 DO ji = fs_2, fs_jpim1 ! vector opt. 1456 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 1457 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 1458 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1459 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1861 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1862 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1460 1863 END DO 1461 1864 END DO 1462 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1463 DO jj = 2, jpjm1 1464 DO ji = 2, jpim1 ! NO vector opt. 1465 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 1466 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1467 zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1468 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1469 zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1470 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1865 CASE( 'weighted oce and ice' ) 1866 SELECT CASE ( cp_ice_msh ) 1867 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1868 DO jj = 2, jpjm1 1869 DO ji = fs_2, fs_jpim1 ! vector opt. 1870 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 1871 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 1872 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1873 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1874 END DO 1471 1875 END DO 1472 END DO1473 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T1474 DO jj = 2, jpjm11475 DO ji = 2, jpim1 ! NO vector opt.1476 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj,1) ) * zfr_l(ji,jj)1477 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj)1478 zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) &1479 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)1480 zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) &1481 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)1876 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1877 DO jj = 2, jpjm1 1878 DO ji = 2, jpim1 ! NO vector opt. 1879 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 1880 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1881 zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1882 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1883 zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1884 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1885 END DO 1482 1886 END DO 1483 END DO 1887 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1888 DO jj = 2, jpjm1 1889 DO ji = 2, jpim1 ! NO vector opt. 1890 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 1891 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1892 zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1893 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1894 zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1895 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1896 END DO 1897 END DO 1898 END SELECT 1899 CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. ) 1900 CASE( 'mixed oce-ice' ) 1901 SELECT CASE ( cp_ice_msh ) 1902 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1903 DO jj = 2, jpjm1 1904 DO ji = fs_2, fs_jpim1 ! vector opt. 1905 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 1906 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1907 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 1908 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1909 END DO 1910 END DO 1911 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1912 DO jj = 2, jpjm1 1913 DO ji = 2, jpim1 ! NO vector opt. 1914 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1915 & + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1916 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1917 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1918 & + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1919 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1920 END DO 1921 END DO 1922 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1923 DO jj = 2, jpjm1 1924 DO ji = 2, jpim1 ! NO vector opt. 1925 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1926 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1927 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1928 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1929 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1930 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1931 END DO 1932 END DO 1933 END SELECT 1484 1934 END SELECT 1485 CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. ) 1486 CASE( 'mixed oce-ice' ) 1487 SELECT CASE ( cp_ice_msh ) 1488 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1489 DO jj = 2, jpjm1 1490 DO ji = fs_2, fs_jpim1 ! vector opt. 1491 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 1492 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1493 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 1494 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1495 END DO 1496 END DO 1497 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1498 DO jj = 2, jpjm1 1499 DO ji = 2, jpim1 ! NO vector opt. 1500 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1501 & + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1502 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1503 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1504 & + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1505 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1506 END DO 1507 END DO 1508 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1509 DO jj = 2, jpjm1 1510 DO ji = 2, jpim1 ! NO vector opt. 1511 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1512 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1513 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1514 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1515 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1516 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1517 END DO 1518 END DO 1519 END SELECT 1520 END SELECT 1521 CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 1935 CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 1936 ! 1937 ENDIF 1522 1938 ! 1523 1939 ! … … 1559 1975 ENDIF 1560 1976 ! 1977 ! 1978 ! Fields sent by OPA to SAS when doing OPA<->SAS coupling 1979 ! ! SSH 1980 IF( ssnd(jps_ssh )%laction ) THEN 1981 ! ! removed inverse barometer ssh when Patm 1982 ! forcing is used (for sea-ice dynamics) 1983 IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 1984 ELSE ; ztmp1(:,:) = sshn(:,:) 1985 ENDIF 1986 CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info ) 1987 1988 ENDIF 1989 ! ! SSS 1990 IF( ssnd(jps_soce )%laction ) THEN 1991 CALL cpl_snd( jps_soce , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info ) 1992 ENDIF 1993 ! ! first T level thickness 1994 IF( ssnd(jps_e3t1st )%laction ) THEN 1995 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1) , (/jpi,jpj,1/) ), info ) 1996 ENDIF 1997 ! ! Qsr fraction 1998 IF( ssnd(jps_fraqsr)%laction ) THEN 1999 CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info ) 2000 ENDIF 2001 ! 2002 ! Fields sent by SAS to OPA when OASIS coupling 2003 ! ! Solar heat flux 2004 IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info ) 2005 IF( ssnd(jps_qnsoce)%laction ) CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info ) 2006 IF( ssnd(jps_oemp )%laction ) CALL cpl_snd( jps_oemp , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info ) 2007 IF( ssnd(jps_sflx )%laction ) CALL cpl_snd( jps_sflx , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info ) 2008 IF( ssnd(jps_otx1 )%laction ) CALL cpl_snd( jps_otx1 , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info ) 2009 IF( ssnd(jps_oty1 )%laction ) CALL cpl_snd( jps_oty1 , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info ) 2010 IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) 2011 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 2012 1561 2013 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 1562 2014 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) -
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
r5307 r5449 8 8 !! 3.0 ! 2006-08 (G. Madec) Surface module 9 9 !! 3.2 ! 2009-07 (C. Talandier) emp mean s spread over erp area 10 !! 3.6 ! 2014-11 (P. Mathiot ) add ice shelf melting 10 11 !!---------------------------------------------------------------------- 11 12 … … 88 89 ! 89 90 IF( kn_fwb == 3 .AND. nn_sssr /= 2 ) CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' ) 90 ! 91 area = glob_sum( e1e2t(:,:) ) ! interior global domain surface 91 IF( kn_fwb == 3 .AND. ln_isfcav ) CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 with ln_isfcav = .TRUE. not working, we stop ' ) 92 ! 93 area = glob_sum( e1e2t(:,:) * tmask(:,:,1)) ! interior global domain surface 94 ! isf cavities are excluded because it can feedback to the melting with generation of inhibition of plumes 95 ! and in case of no melt, it can generate HSSW. 92 96 ! 93 97 #if ! defined key_lim2 && ! defined key_lim3 && ! defined key_cice … … 106 110 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) - snwice_fmass(:,:) ) ) / area ! sum over the global domain 107 111 zcoef = z_fwf * rcp 108 emp(:,:) = emp(:,:) - z_fwf 109 qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) ! account for change to the heat budget due to fw correction112 emp(:,:) = emp(:,:) - z_fwf * tmask(:,:,1) 113 qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction 110 114 ENDIF 111 115 ! … … 138 142 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN ! correct the freshwater fluxes 139 143 zcoef = fwfold * rcp 140 emp(:,:) = emp(:,:) + fwfold 141 qns(:,:) = qns(:,:) - zcoef * sst_m(:,:) ! account for change to the heat budget due to fw correction144 emp(:,:) = emp(:,:) + fwfold * tmask(:,:,1) 145 qns(:,:) = qns(:,:) - zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction 142 146 ENDIF 143 147 ! … … 158 162 zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) ) 159 163 ! ! fwf global mean (excluding ocean to ice/snow exchanges) 160 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - snwice_fmass(:,:) ) ) / area164 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) - snwice_fmass(:,:) ) ) / area 161 165 ! 162 166 IF( z_fwf < 0._wp ) THEN ! spread out over >0 erp area to increase evaporation -
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
- Property svn:keywords set to Id
r4990 r5449 40 40 # if defined key_cice4 41 41 USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow, & 42 strocnxT,strocnyT, & 42 43 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_gbm, & 43 44 fresh_gbm,fhocn_gbm,fswthru_gbm,frzmlt, & … … 48 49 #else 49 50 USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow, & 51 strocnxT,strocnyT, & 50 52 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai, & 51 53 fresh_ai,fhocn_ai,fswthru_ai,frzmlt, & … … 94 96 # include "domzgr_substitute.h90" 95 97 98 !! $Id$ 96 99 CONTAINS 97 100 … … 135 138 IF ( ksbc == jp_flx ) THEN 136 139 CALL cice_sbc_force(kt) 137 ELSE IF ( ksbc == jp_ cpl ) THEN140 ELSE IF ( ksbc == jp_purecpl ) THEN 138 141 CALL sbc_cpl_ice_flx( 1.0-fr_i ) 139 142 ENDIF … … 143 146 CALL cice_sbc_out ( kt, ksbc ) 144 147 145 IF ( ksbc == jp_ cpl ) CALL cice_sbc_hadgam(kt+1)148 IF ( ksbc == jp_purecpl ) CALL cice_sbc_hadgam(kt+1) 146 149 147 150 ENDIF ! End sea-ice time step only … … 184 187 185 188 ! Do some CICE consistency checks 186 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_ cpl) ) THEN189 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 187 190 IF ( calc_strair .OR. calc_Tsfc ) THEN 188 191 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) … … 209 212 210 213 CALL cice2nemo(aice,fr_i, 'T', 1. ) 211 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_ cpl) ) THEN214 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 212 215 DO jl=1,ncat 213 216 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 316 319 ! forced and coupled case 317 320 318 IF ( (ksbc == jp_flx).OR.(ksbc == jp_ cpl) ) THEN321 IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 319 322 320 323 ztmpn(:,:,:)=0.0 … … 560 563 ! Combine wind stress and ocean-ice stress 561 564 ! [Note that fr_iu hasn't yet been updated, so still from start of CICE timestep] 565 ! strocnx and strocny already weighted by ice fraction in CICE so not done here 562 566 563 567 utau(:,:)=(1.0-fr_iu(:,:))*utau(:,:)-ss_iou(:,:) 564 568 vtau(:,:)=(1.0-fr_iv(:,:))*vtau(:,:)-ss_iov(:,:) 569 570 ! Also need ice/ocean stress on T points so that taum can be updated 571 ! This interpolation is already done in CICE so best to use those values 572 CALL cice2nemo(strocnxT,ztmp1,'T',-1.) 573 CALL cice2nemo(strocnyT,ztmp2,'T',-1.) 574 575 ! Update taum with modulus of ice-ocean stress 576 ! strocnxT and strocnyT are not weighted by ice fraction in CICE so must be done here 577 taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1**2. + ztmp2**2.) 565 578 566 579 ! Freshwater fluxes … … 574 587 ELSE IF (ksbc == jp_core) THEN 575 588 emp(:,:) = (1.0-fr_i(:,:))*emp(:,:) 576 ELSE IF (ksbc == jp_ cpl) THEN589 ELSE IF (ksbc == jp_purecpl) THEN 577 590 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) 578 591 ! This is currently as required with the coupling fields from the UM atmosphere … … 610 623 ENDIF 611 624 ! Take into account snow melting except for fully coupled when already in qns_tot 612 IF (ksbc == jp_ cpl) THEN625 IF (ksbc == jp_purecpl) THEN 613 626 qsr(:,:)= qsr_tot(:,:) 614 627 qns(:,:)= qns_tot(:,:) … … 645 658 646 659 CALL cice2nemo(aice,fr_i,'T', 1. ) 647 IF ( (ksbc == jp_flx).OR.(ksbc == jp_ cpl) ) THEN660 IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 648 661 DO jl=1,ncat 649 662 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 1083 1096 !! Default option Dummy module NO CICE sea-ice model 1084 1097 !!---------------------------------------------------------------------- 1098 !! $Id$ 1085 1099 CONTAINS 1086 1100 -
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
r5307 r5449 105 105 fr_i(:,:) = eos_fzp( sss_m ) * tmask(:,:,1) ! sea surface freezing temperature [Celcius] 106 106 107 IF( l k_cpl ) a_i(:,:,1) = fr_i(:,:)107 IF( ln_cpl ) a_i(:,:,1) = fr_i(:,:) 108 108 109 109 ! Flux and ice fraction computation -
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r5307 r5449 19 19 !!---------------------------------------------------------------------- 20 20 !! sbc_ice_lim : sea-ice model time-stepping and update ocean sbc over ice-covered area 21 !! lim_ctl : alerts in case of ice model crash22 !! lim_prt_state : ice control print at a given grid point23 21 !!---------------------------------------------------------------------- 24 22 USE oce ! ocean dynamics and tracers 25 23 USE dom_oce ! ocean space and time domain 26 USE par_ice ! sea-ice parameters27 24 USE ice ! LIM-3: ice variables 28 USE iceini ! LIM-3: ice initialisation25 USE thd_ice ! LIM-3: thermodynamical variables 29 26 USE dom_ice ! LIM-3: ice domain 30 27 … … 40 37 USE limdyn ! Ice dynamics 41 38 USE limtrp ! Ice transport 39 USE limhdf ! Ice horizontal diffusion 42 40 USE limthd ! Ice thermodynamics 43 USE limitd_th ! Thermodynamics on ice thickness distribution44 41 USE limitd_me ! Mechanics on ice thickness distribution 45 42 USE limsbc ! sea surface boundary condition … … 47 44 USE limwri ! Ice outputs 48 45 USE limrst ! Ice restarts 49 USE limupdate1 50 USE limupdate2 46 USE limupdate1 ! update of global variables 47 USE limupdate2 ! update of global variables 51 48 USE limvar ! Ice variables switch 49 50 USE limmsh ! LIM mesh 51 USE limistate ! LIM initial state 52 USE limthd_sal ! LIM ice thermodynamics: salinity 52 53 53 54 USE c1d ! 1D vertical configuration … … 60 61 USE prtctl ! Print control 61 62 USE lib_fortran ! 63 USE limctl 62 64 63 65 #if defined key_bdy … … 69 71 70 72 PUBLIC sbc_ice_lim ! routine called by sbcmod.F90 71 PUBLIC lim_prt_state73 PUBLIC sbc_lim_init ! routine called by sbcmod.F90 72 74 73 75 !! * Substitutions … … 106 108 INTEGER, INTENT(in) :: kblk ! type of bulk (=3 CLIO, =4 CORE, =5 COUPLED) 107 109 !! 108 INTEGER :: jl ! dummy loop index 109 REAL(wp) :: zcoef ! local scalar 110 INTEGER :: jl ! dummy loop index 110 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 111 112 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice ! mean ice albedo (for coupled) 113 REAL(wp), POINTER, DIMENSION(:,: ) :: zutau_ice, zvtau_ice 112 114 !!---------------------------------------------------------------------- 113 115 114 116 IF( nn_timing == 1 ) CALL timing_start('sbc_ice_lim') 115 117 116 IF( kt == nit000 ) THEN 117 IF(lwp) WRITE(numout,*) 118 IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition' 119 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ via Louvain la Neuve Ice Model (LIM-3) time stepping' 120 ! 121 CALL ice_init 122 ! 123 IF( ln_nicep ) THEN ! control print at a given point 124 jiindx = 15 ; jjindx = 44 125 IF(lwp) WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx 126 ENDIF 127 ENDIF 128 129 ! !----------------------! 130 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Ice time-step only ! 131 ! !----------------------! 132 ! ! Bulk Formulae ! 133 ! !----------------! 134 ! 135 u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) ! mean surface ocean current at ice velocity point 136 v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) ! (C-grid dynamics : U- & V-points as the ocean) 137 ! 138 t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1. - tmask(:,:,1) ) ! masked sea surface freezing temperature [Kelvin] 139 ! ! (set to rt0 over land) 140 ! ! Ice albedo 141 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 142 143 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 144 118 !-----------------------! 119 ! --- Ice time step --- ! 120 !-----------------------! 121 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 122 123 ! mean surface ocean current at ice velocity point (C-grid dynamics : U- & V-points as the ocean) 124 u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) 125 v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) 126 127 ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 128 t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 129 130 ! Mask sea ice surface temperature (set to rt0 over land) 131 DO jl = 1, jpl 132 t_su(:,:,jl) = t_su(:,:,jl) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 133 END DO 134 ! 135 !------------------------------------------------! 136 ! --- Dynamical coupling with the atmosphere --- ! 137 !------------------------------------------------! 138 ! It provides the following fields: 139 ! utau_ice, vtau_ice : surface ice stress (U- & V-points) [N/m2] 140 !----------------------------------------------------------------- 145 141 SELECT CASE( kblk ) 146 CASE( jp_core , jp_cpl ) ! CORE and COUPLED bulk formulations 147 148 ! albedo depends on cloud fraction because of non-linear spectral effects 149 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 150 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 151 ! (zalb_ice) is computed within the bulk routine 152 142 CASE( jp_clio ) ; CALL blk_ice_clio_tau ! CLIO bulk formulation 143 CASE( jp_core ) ; CALL blk_ice_core_tau ! CORE bulk formulation 144 CASE( jp_purecpl ) ; CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) ! Coupled formulation 153 145 END SELECT 154 146 155 ! ! Mask sea ice surface temperature 156 DO jl = 1, jpl 157 t_su(:,:,jl) = t_su(:,:,jl) + rt0 * ( 1. - tmask(:,:,1) ) 158 END DO 159 160 ! Bulk formulae - provides the following fields: 161 ! utau_ice, vtau_ice : surface ice stress (U- & V-points) [N/m2] 147 IF( ln_mixcpl) THEN ! Case of a mixed Bulk/Coupled formulation 148 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) 149 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 150 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 151 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 152 CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice) 153 ENDIF 154 155 !-------------------------------------------------------! 156 ! --- ice dynamics and transport (except in 1D case) ---! 157 !-------------------------------------------------------! 158 numit = numit + nn_fsbc ! Ice model time step 159 ! 160 CALL sbc_lim_bef ! Store previous ice values 161 CALL sbc_lim_diag0 ! set diag of mass, heat and salt fluxes to 0 162 CALL lim_rst_opn( kt ) ! Open Ice restart file 163 ! 164 IF( .NOT. lk_c1d ) THEN 165 ! 166 CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics ) 167 ! 168 CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion ) 169 ! 170 IF( nn_monocat /= 2 ) CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting) 171 ! 172 #if defined key_bdy 173 CALL bdy_ice_lim( kt ) ! bdy ice thermo 174 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 175 #endif 176 ! 177 CALL lim_update1( kt ) ! Corrections 178 ! 179 ENDIF 180 181 ! previous lead fraction and ice volume for flux calculations 182 CALL sbc_lim_bef 183 CALL lim_var_glo2eqv ! ht_i and ht_s for ice albedo calculation 184 CALL lim_var_agg(1) ! at_i for coupling (via pfrld) 185 pfrld(:,:) = 1._wp - at_i(:,:) 186 phicif(:,:) = vt_i(:,:) 187 188 !------------------------------------------------------! 189 ! --- Thermodynamical coupling with the atmosphere --- ! 190 !------------------------------------------------------! 191 ! It provides the following fields: 162 192 ! qsr_ice , qns_ice : solar & non solar heat flux over ice (T-point) [W/m2] 163 193 ! qla_ice : latent heat flux over ice (T-point) [W/m2] … … 165 195 ! tprecip , sprecip : total & solid precipitation (T-point) [Kg/m2/s] 166 196 ! fr1_i0 , fr2_i0 : 1sr & 2nd fraction of qsr penetration in ice [%] 167 ! 197 !---------------------------------------------------------------------------------------- 198 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 199 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 200 168 201 SELECT CASE( kblk ) 169 202 CASE( jp_clio ) ! CLIO bulk formulation 170 CALL blk_ice_clio( t_su , zalb_cs , zalb_os , zalb_ice , & 171 & utau_ice , vtau_ice , qns_ice , qsr_ice , & 172 & qla_ice , dqns_ice , dqla_ice , & 173 & tprecip , sprecip , & 174 & fr1_i0 , fr2_i0 , cp_ice_msh, jpl ) 175 ! 176 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 177 & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 178 203 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 204 ! (zalb_ice) is computed within the bulk routine 205 CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, zalb_ice ) 206 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 207 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 179 208 CASE( jp_core ) ! CORE bulk formulation 180 CALL blk_ice_core( t_su , u_ice , v_ice , zalb_ice , & 181 & utau_ice , vtau_ice , qns_ice , qsr_ice , & 182 & qla_ice , dqns_ice , dqla_ice , & 183 & tprecip , sprecip , & 184 & fr1_i0 , fr2_i0 , cp_ice_msh, jpl ) 185 ! 186 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 187 & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 188 ! 189 CASE ( jp_cpl ) 190 191 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 192 193 ! MV -> seb 194 ! CALL sbc_cpl_ice_flx( p_frld=ato_i, palbi=zalb_ice, psst=sst_m, pist=t_su ) 195 196 ! IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 197 ! & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 198 ! ! Latent heat flux is forced to 0 in coupled : 199 ! ! it is included in qns (non-solar heat flux) 200 ! qla_ice (:,:,:) = 0._wp 201 ! dqla_ice (:,:,:) = 0._wp 202 ! END MV -> seb 203 ! 209 ! albedo depends on cloud fraction because of non-linear spectral effects 210 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 211 CALL blk_ice_core_flx( t_su, zalb_ice ) 212 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 213 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 214 CASE ( jp_purecpl ) 215 ! albedo depends on cloud fraction because of non-linear spectral effects 216 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 217 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 218 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 219 ! Latent heat flux is forced to 0 in coupled: it is included in qns (non-solar heat flux) 220 evap_ice (:,:,:) = 0._wp 221 devap_ice (:,:,:) = 0._wp 204 222 END SELECT 205 206 ! !----------------------! 207 ! ! LIM-3 time-stepping ! 208 ! !----------------------! 209 ! 210 numit = numit + nn_fsbc ! Ice model time step 211 ! 212 ! ! Store previous ice values 213 a_i_b (:,:,:) = a_i (:,:,:) ! ice area 214 e_i_b (:,:,:,:) = e_i (:,:,:,:) ! ice thermal energy 215 v_i_b (:,:,:) = v_i (:,:,:) ! ice volume 216 v_s_b (:,:,:) = v_s (:,:,:) ! snow volume 217 e_s_b (:,:,:,:) = e_s (:,:,:,:) ! snow thermal energy 218 smv_i_b(:,:,:) = smv_i(:,:,:) ! salt content 219 oa_i_b (:,:,:) = oa_i (:,:,:) ! areal age content 220 u_ice_b(:,:) = u_ice(:,:) 221 v_ice_b(:,:) = v_ice(:,:) 222 223 ! salt, heat and mass fluxes 224 sfx (:,:) = 0._wp ; 225 sfx_bri(:,:) = 0._wp ; 226 sfx_sni(:,:) = 0._wp ; sfx_opw(:,:) = 0._wp 227 sfx_bog(:,:) = 0._wp ; sfx_dyn(:,:) = 0._wp 228 sfx_bom(:,:) = 0._wp ; sfx_sum(:,:) = 0._wp 229 sfx_res(:,:) = 0._wp 230 231 wfx_snw(:,:) = 0._wp ; wfx_ice(:,:) = 0._wp 232 wfx_sni(:,:) = 0._wp ; wfx_opw(:,:) = 0._wp 233 wfx_bog(:,:) = 0._wp ; wfx_dyn(:,:) = 0._wp 234 wfx_bom(:,:) = 0._wp ; wfx_sum(:,:) = 0._wp 235 wfx_res(:,:) = 0._wp ; wfx_sub(:,:) = 0._wp 236 wfx_spr(:,:) = 0._wp ; 237 238 hfx_in (:,:) = 0._wp ; hfx_out(:,:) = 0._wp 239 hfx_thd(:,:) = 0._wp ; 240 hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp 241 hfx_bog(:,:) = 0._wp ; hfx_dyn(:,:) = 0._wp 242 hfx_bom(:,:) = 0._wp ; hfx_sum(:,:) = 0._wp 243 hfx_res(:,:) = 0._wp ; hfx_sub(:,:) = 0._wp 244 hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp 245 hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp 246 247 CALL lim_rst_opn( kt ) ! Open Ice restart file 248 ! 249 IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - Beginning the time step - ' ) ! control print 250 ! ---------------------------------------------- 251 ! ice dynamics and transport (except in 1D case) 252 ! ---------------------------------------------- 253 IF( .NOT. lk_c1d ) THEN 254 CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics ) 255 CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion ) 256 CALL lim_var_glo2eqv ! equivalent variables, requested for rafting 257 IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx,-1, ' - ice dyn & trp - ' ) ! control print 258 CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting) 259 CALL lim_var_agg( 1 ) 260 #if defined key_bdy 261 ! bdy ice thermo 262 CALL lim_var_glo2eqv ! equivalent variables 263 CALL bdy_ice_lim( kt ) 264 CALL lim_itd_me_zapsmall 265 CALL lim_var_agg(1) 266 IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermo bdy - ' ) ! control print 267 #endif 268 CALL lim_update1 269 ENDIF 270 ! !- Change old values for new values 271 u_ice_b(:,:) = u_ice(:,:) 272 v_ice_b(:,:) = v_ice(:,:) 273 a_i_b (:,:,:) = a_i (:,:,:) 274 v_s_b (:,:,:) = v_s (:,:,:) 275 v_i_b (:,:,:) = v_i (:,:,:) 276 e_s_b (:,:,:,:) = e_s (:,:,:,:) 277 e_i_b (:,:,:,:) = e_i (:,:,:,:) 278 oa_i_b (:,:,:) = oa_i (:,:,:) 279 smv_i_b(:,:,:) = smv_i(:,:,:) 280 281 ! ---------------------------------------------- 282 ! ice thermodynamic 283 ! ---------------------------------------------- 284 CALL lim_var_glo2eqv ! equivalent variables 285 CALL lim_var_agg(1) ! aggregate ice categories 286 ! previous lead fraction and ice volume for flux calculations 287 pfrld(:,:) = 1._wp - at_i(:,:) 288 phicif(:,:) = vt_i(:,:) 289 290 ! MV -> seb 291 SELECT CASE( kblk ) 292 CASE ( jp_cpl ) 293 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 294 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 295 & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 296 ! Latent heat flux is forced to 0 in coupled : 297 ! it is included in qns (non-solar heat flux) 298 qla_ice (:,:,:) = 0._wp 299 dqla_ice (:,:,:) = 0._wp 300 END SELECT 301 ! END MV -> seb 302 ! 303 CALL lim_var_bv ! bulk brine volume (diag) 304 CALL lim_thd( kt ) ! Ice thermodynamics 305 zcoef = rdt_ice /rday ! Ice natural aging 306 oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef 307 IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermodyn. - ' ) ! control print 308 CALL lim_itd_th( kt ) ! Remap ice categories, lateral accretion ! 309 CALL lim_var_agg( 1 ) ! requested by limupdate 310 CALL lim_update2 ! Global variables update 311 312 CALL lim_var_glo2eqv ! equivalent variables (outputs) 313 CALL lim_var_agg(2) ! aggregate ice thickness categories 314 IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx, 2, ' - Final state - ' ) ! control print 315 ! 316 CALL lim_sbc_flx( kt ) ! Update surface ocean mass, heat and salt fluxes 317 ! 318 IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx, 3, ' - Final state lim_sbc - ' ) ! control print 319 ! 320 ! ! Diagnostics and outputs 321 IF (ln_limdiaout) CALL lim_diahsb 322 323 CALL lim_wri( 1 ) ! Ice outputs 324 223 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 224 225 !----------------------------! 226 ! --- ice thermodynamics --- ! 227 !----------------------------! 228 CALL lim_thd( kt ) ! Ice thermodynamics 229 ! 230 CALL lim_update2( kt ) ! Corrections 231 ! 232 CALL lim_sbc_flx( kt ) ! Update surface ocean mass, heat and salt fluxes 233 ! 234 IF(ln_limdiaout) CALL lim_diahsb ! Diagnostics and outputs 235 ! 236 CALL lim_wri( 1 ) ! Ice outputs 237 ! 325 238 IF( kt == nit000 .AND. ln_rstart ) & 326 & CALL iom_close( numrir ) ! clem: close input ice restart file 327 ! 328 IF( lrst_ice ) CALL lim_rst_write( kt ) ! Ice restart file 329 CALL lim_var_glo2eqv ! ??? 330 ! 331 IF( ln_nicep ) CALL lim_ctl( kt ) ! alerts in case of model crash 332 ! 333 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 334 ! 335 ENDIF ! End sea-ice time step only 336 337 ! !--------------------------! 338 ! ! at all ocean time step ! 339 ! !--------------------------! 340 ! 341 ! ! Update surface ocean stresses (only in ice-dynamic case) 342 ! ! otherwise the atm.-ocean stresses are used everywhere 239 & CALL iom_close( numrir ) ! close input ice restart file 240 ! 241 IF( lrst_ice ) CALL lim_rst_write( kt ) ! Ice restart file 242 ! 243 IF( ln_icectl ) CALL lim_ctl( kt ) ! alerts in case of model crash 244 ! 245 ENDIF ! End sea-ice time step only 246 247 !-------------------------! 248 ! --- Ocean time step --- ! 249 !-------------------------! 250 ! Update surface ocean stresses (only in ice-dynamic case) otherwise the atm.-ocean stresses are used everywhere 343 251 IF( ln_limdyn ) CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 344 252 !!gm remark, the ocean-ice stress is not saved in ice diag call above ..... find a solution!!! 345 346 ! 347 IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_lim') 253 ! 254 IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_lim') 348 255 ! 349 256 END SUBROUTINE sbc_ice_lim 350 257 258 259 SUBROUTINE sbc_lim_init 260 !!---------------------------------------------------------------------- 261 !! *** ROUTINE sbc_lim_init *** 262 !! 263 !! ** purpose : Allocate all the dynamic arrays of the LIM-3 modules 264 !!---------------------------------------------------------------------- 265 INTEGER :: ierr 266 !!---------------------------------------------------------------------- 267 IF(lwp) WRITE(numout,*) 268 IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition' 269 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ via Louvain la Neuve Ice Model (LIM-3) time stepping' 270 ! 271 ! Open the reference and configuration namelist files and namelist output file 272 CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 273 CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 274 IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 ) 275 276 CALL ice_run ! set some ice run parameters 277 ! 278 ! ! Allocate the ice arrays 279 ierr = ice_alloc () ! ice variables 280 ierr = ierr + dom_ice_alloc () ! domain 281 ierr = ierr + sbc_ice_alloc () ! surface forcing 282 ierr = ierr + thd_ice_alloc () ! thermodynamics 283 ierr = ierr + lim_itd_me_alloc () ! ice thickness distribution - mechanics 284 ! 285 IF( lk_mpp ) CALL mpp_sum( ierr ) 286 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'sbc_lim_init : unable to allocate ice arrays') 287 ! 288 ! ! adequation jpk versus ice/snow layers/categories 289 IF( jpl > jpk .OR. (nlay_i+1) > jpk .OR. nlay_s > jpk ) & 290 & CALL ctl_stop( 'STOP', & 291 & 'sbc_lim_init: the 3rd dimension of workspace arrays is too small.', & 292 & 'use more ocean levels or less ice/snow layers/categories.' ) 293 ! 294 CALL lim_itd_init ! ice thickness distribution initialization 295 ! 296 CALL lim_hdf_init ! set ice horizontal diffusion computation parameters 297 ! 298 CALL lim_thd_init ! set ice thermodynics parameters 299 ! 300 CALL lim_thd_sal_init ! set ice salinity parameters 301 ! 302 CALL lim_msh ! ice mesh initialization 303 ! 304 CALL lim_itd_me_init ! ice thickness distribution initialization for mecanical deformation 305 ! ! Initial sea-ice state 306 IF( .NOT. ln_rstart ) THEN ! start from rest: sea-ice deduced from sst 307 numit = 0 308 numit = nit000 - 1 309 CALL lim_istate 310 ELSE ! start from a restart file 311 CALL lim_rst_read 312 numit = nit000 - 1 313 ENDIF 314 CALL lim_var_agg(1) 315 CALL lim_var_glo2eqv 316 ! 317 CALL lim_sbc_init ! ice surface boundary condition 318 ! 319 fr_i(:,:) = at_i(:,:) ! initialisation of sea-ice fraction 320 tn_ice(:,:,:) = t_su(:,:,:) ! initialisation of surface temp for coupled simu 321 ! 322 nstart = numit + nn_fsbc 323 nitrun = nitend - nit000 + 1 324 nlast = numit + nitrun 325 ! 326 IF( nstock == 0 ) nstock = nlast + 1 327 ! 328 END SUBROUTINE sbc_lim_init 329 330 331 SUBROUTINE ice_run 332 !!------------------------------------------------------------------- 333 !! *** ROUTINE ice_run *** 334 !! 335 !! ** Purpose : Definition some run parameter for ice model 336 !! 337 !! ** Method : Read the namicerun namelist and check the parameter 338 !! values called at the first timestep (nit000) 339 !! 340 !! ** input : Namelist namicerun 341 !!------------------------------------------------------------------- 342 INTEGER :: ios ! Local integer output status for namelist read 343 NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir, & 344 & ln_limdyn, rn_amax, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt 345 !!------------------------------------------------------------------- 346 ! 347 REWIND( numnam_ice_ref ) ! Namelist namicerun in reference namelist : Parameters for ice 348 READ ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901) 349 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp ) 350 351 REWIND( numnam_ice_cfg ) ! Namelist namicerun in configuration namelist : Parameters for ice 352 READ ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 ) 353 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) 354 IF(lwm) WRITE ( numoni, namicerun ) 355 ! 356 ! 357 IF(lwp) THEN ! control print 358 WRITE(numout,*) 359 WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice' 360 WRITE(numout,*) ' ~~~~~~' 361 WRITE(numout,*) ' number of ice categories = ', jpl 362 WRITE(numout,*) ' number of ice layers = ', nlay_i 363 WRITE(numout,*) ' number of snow layers = ', nlay_s 364 WRITE(numout,*) ' switch for ice dynamics (1) or not (0) ln_limdyn = ', ln_limdyn 365 WRITE(numout,*) ' maximum ice concentration = ', rn_amax 366 WRITE(numout,*) ' Diagnose heat/salt budget or not ln_limdiahsb = ', ln_limdiahsb 367 WRITE(numout,*) ' Output heat/salt budget or not ln_limdiaout = ', ln_limdiaout 368 WRITE(numout,*) ' control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_icectl 369 WRITE(numout,*) ' i-index for control prints (ln_icectl=true) = ', iiceprt 370 WRITE(numout,*) ' j-index for control prints (ln_icectl=true) = ', jiceprt 371 ENDIF 372 ! 373 ! sea-ice timestep and inverse 374 rdt_ice = nn_fsbc * rdttra(1) 375 r1_rdtice = 1._wp / rdt_ice 376 377 ! inverse of nlay_i and nlay_s 378 r1_nlay_i = 1._wp / REAL( nlay_i, wp ) 379 r1_nlay_s = 1._wp / REAL( nlay_s, wp ) 380 ! 381 #if defined key_bdy 382 IF( lwp .AND. ln_limdiahsb ) CALL ctl_warn('online conservation check activated but it does not work with BDY') 383 #endif 384 ! 385 END SUBROUTINE ice_run 386 387 388 SUBROUTINE lim_itd_init 389 !!------------------------------------------------------------------ 390 !! *** ROUTINE lim_itd_init *** 391 !! 392 !! ** Purpose : Initializes the ice thickness distribution 393 !! ** Method : ... 394 !! ** input : Namelist namiceitd 395 !!------------------------------------------------------------------- 396 INTEGER :: ios ! Local integer output status for namelist read 397 NAMELIST/namiceitd/ nn_catbnd, rn_himean 398 ! 399 INTEGER :: jl ! dummy loop index 400 REAL(wp) :: zc1, zc2, zc3, zx1 ! local scalars 401 REAL(wp) :: zhmax, znum, zden, zalpha ! 402 !!------------------------------------------------------------------ 403 ! 404 REWIND( numnam_ice_ref ) ! Namelist namiceitd in reference namelist : Parameters for ice 405 READ ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 903) 406 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp ) 407 408 REWIND( numnam_ice_cfg ) ! Namelist namiceitd in configuration namelist : Parameters for ice 409 READ ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 904 ) 410 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp ) 411 IF(lwm) WRITE ( numoni, namiceitd ) 412 ! 413 ! 414 IF(lwp) THEN ! control print 415 WRITE(numout,*) 416 WRITE(numout,*) 'ice_itd : ice cat distribution' 417 WRITE(numout,*) ' ~~~~~~' 418 WRITE(numout,*) ' shape of ice categories distribution nn_catbnd = ', nn_catbnd 419 WRITE(numout,*) ' mean ice thickness in the domain (only active if nn_catbnd=2) rn_himean = ', rn_himean 420 ENDIF 421 422 !---------------------------------- 423 !- Thickness categories boundaries 424 !---------------------------------- 425 IF(lwp) WRITE(numout,*) 426 IF(lwp) WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution ' 427 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 428 429 hi_max(:) = 0._wp 430 431 SELECT CASE ( nn_catbnd ) 432 !---------------------- 433 CASE (1) ! tanh function (CICE) 434 !---------------------- 435 zc1 = 3._wp / REAL( jpl, wp ) 436 zc2 = 10._wp * zc1 437 zc3 = 3._wp 438 439 DO jl = 1, jpl 440 zx1 = REAL( jl-1, wp ) / REAL( jpl, wp ) 441 hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) ) 442 END DO 443 444 !---------------------- 445 CASE (2) ! h^(-alpha) function 446 !---------------------- 447 zalpha = 0.05 ! exponent of the transform function 448 449 zhmax = 3.*rn_himean 450 451 DO jl = 1, jpl 452 znum = jpl * ( zhmax+1 )**zalpha 453 zden = ( jpl - jl ) * ( zhmax+1 )**zalpha + jl 454 hi_max(jl) = ( znum / zden )**(1./zalpha) - 1 455 END DO 456 457 END SELECT 458 459 DO jl = 1, jpl 460 hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp 461 END DO 462 463 ! Set hi_max(jpl) to a big value to ensure that all ice is thinner than hi_max(jpl) 464 hi_max(jpl) = 99._wp 465 466 IF(lwp) WRITE(numout,*) ' Thickness category boundaries ' 467 IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl) 468 ! 469 END SUBROUTINE lim_itd_init 470 351 471 352 SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, & 353 & pdqn_ice, pqla_ice, pdql_ice, k_limflx ) 472 SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 354 473 !!--------------------------------------------------------------------- 355 !! *** ROUTINE sbc_ice_lim***474 !! *** ROUTINE ice_lim_flx *** 356 475 !! 357 476 !! ** Purpose : update the ice surface boundary condition by averaging and / or … … 369 488 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pqsr_ice ! net solar flux 370 489 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdqn_ice ! non solar flux sensitivity 371 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p qla_ice ! latent heat flux372 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pd ql_ice ! latent heat fluxsensitivity490 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pevap_ice ! sublimation 491 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdevap_ice ! sublimation sensitivity 373 492 ! 374 493 INTEGER :: jl ! dummy loop index … … 379 498 REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_m ! Mean solar heat flux over all categories 380 499 REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_m ! Mean non solar heat flux over all categories 381 REAL(wp), POINTER, DIMENSION(:,:) :: z_ qla_m ! Mean latent heat fluxover all categories500 REAL(wp), POINTER, DIMENSION(:,:) :: z_evap_m ! Mean sublimation over all categories 382 501 REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m ! Mean d(qns)/dT over all categories 383 REAL(wp), POINTER, DIMENSION(:,:) :: z_d ql_m ! Mean d(qla)/dT over all categories502 REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories 384 503 !!---------------------------------------------------------------------- 385 504 … … 389 508 SELECT CASE( k_limflx ) !== averaged on all ice categories ==! 390 509 CASE( 0 , 1 ) 391 CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_ qla_m, z_dqn_m, z_dql_m)392 ! 393 z_qns_m (:,:) = fice_ice_ave ( pqns_ice (:,:,:) )394 z_qsr_m (:,:) = fice_ice_ave ( pqsr_ice (:,:,:) )395 z_dqn_m (:,:) = fice_ice_ave ( pdqn_ice (:,:,:) )396 z_ qla_m(:,:) = fice_ice_ave ( pqla_ice (:,:,:) )397 z_d ql_m(:,:) = fice_ice_ave ( pdql_ice (:,:,:) )510 CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 511 ! 512 z_qns_m (:,:) = fice_ice_ave ( pqns_ice (:,:,:) ) 513 z_qsr_m (:,:) = fice_ice_ave ( pqsr_ice (:,:,:) ) 514 z_dqn_m (:,:) = fice_ice_ave ( pdqn_ice (:,:,:) ) 515 z_evap_m (:,:) = fice_ice_ave ( pevap_ice (:,:,:) ) 516 z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) ) 398 517 DO jl = 1, jpl 399 pdqn_ice (:,:,jl) = z_dqn_m(:,:)400 pd ql_ice(:,:,jl) = z_dql_m(:,:)518 pdqn_ice (:,:,jl) = z_dqn_m(:,:) 519 pdevap_ice(:,:,jl) = z_devap_m(:,:) 401 520 END DO 402 521 ! 403 522 DO jl = 1, jpl 404 pqns_ice (:,:,jl) = z_qns_m(:,:)405 pqsr_ice (:,:,jl) = z_qsr_m(:,:)406 p qla_ice(:,:,jl) = z_qla_m(:,:)523 pqns_ice (:,:,jl) = z_qns_m(:,:) 524 pqsr_ice (:,:,jl) = z_qsr_m(:,:) 525 pevap_ice(:,:,jl) = z_evap_m(:,:) 407 526 END DO 408 527 ! 409 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_ qla_m, z_dqn_m, z_dql_m)528 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 410 529 END SELECT 411 530 … … 417 536 ztem_m(:,:) = fice_ice_ave ( ptn_ice (:,:,:) ) 418 537 DO jl = 1, jpl 419 pqns_ice (:,:,jl) = pqns_ice(:,:,jl) + pdqn_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:))420 p qla_ice(:,:,jl) = pqla_ice(:,:,jl) + pdql_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:))421 pqsr_ice (:,:,jl) = pqsr_ice(:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) )538 pqns_ice (:,:,jl) = pqns_ice (:,:,jl) + pdqn_ice (:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 539 pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 540 pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 422 541 END DO 423 542 ! … … 428 547 ! 429 548 END SUBROUTINE ice_lim_flx 430 431 432 SUBROUTINE lim_ctl( kt ) 433 !!----------------------------------------------------------------------- 434 !! *** ROUTINE lim_ctl *** 435 !! 436 !! ** Purpose : Alerts in case of model crash 437 !!------------------------------------------------------------------- 438 INTEGER, INTENT(in) :: kt ! ocean time step 439 INTEGER :: ji, jj, jk, jl ! dummy loop indices 440 INTEGER :: inb_altests ! number of alert tests (max 20) 441 INTEGER :: ialert_id ! number of the current alert 442 REAL(wp) :: ztmelts ! ice layer melting point 443 CHARACTER (len=30), DIMENSION(20) :: cl_alname ! name of alert 444 INTEGER , DIMENSION(20) :: inb_alp ! number of alerts positive 445 !!------------------------------------------------------------------- 446 447 inb_altests = 10 448 inb_alp(:) = 0 449 450 ! Alert if incompatible volume and concentration 451 ialert_id = 2 ! reference number of this alert 452 cl_alname(ialert_id) = ' Incompat vol and con ' ! name of the alert 453 454 DO jl = 1, jpl 455 DO jj = 1, jpj 456 DO ji = 1, jpi 457 IF( v_i(ji,jj,jl) /= 0._wp .AND. a_i(ji,jj,jl) == 0._wp ) THEN 458 !WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration ' 459 !WRITE(numout,*) ' at_i ', at_i(ji,jj) 460 !WRITE(numout,*) ' Point - category', ji, jj, jl 461 !WRITE(numout,*) ' a_i *** a_i_b ', a_i (ji,jj,jl), a_i_b (ji,jj,jl) 462 !WRITE(numout,*) ' v_i *** v_i_b ', v_i (ji,jj,jl), v_i_b (ji,jj,jl) 463 !WRITE(numout,*) ' d_a_i_thd/trp ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl) 464 !WRITE(numout,*) ' d_v_i_thd/trp ', d_v_i_thd(ji,jj,jl), d_v_i_trp(ji,jj,jl) 465 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 466 ENDIF 467 END DO 468 END DO 469 END DO 470 471 ! Alerte if very thick ice 472 ialert_id = 3 ! reference number of this alert 473 cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert 474 jl = jpl 475 DO jj = 1, jpj 476 DO ji = 1, jpi 477 IF( ht_i(ji,jj,jl) > 50._wp ) THEN 478 !CALL lim_prt_state( kt, ji, jj, 2, ' ALERTE 3 : Very thick ice ' ) 479 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 480 ENDIF 481 END DO 482 END DO 483 484 ! Alert if very fast ice 485 ialert_id = 4 ! reference number of this alert 486 cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert 487 DO jj = 1, jpj 488 DO ji = 1, jpi 489 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 1.5 .AND. & 490 & at_i(ji,jj) > 0._wp ) THEN 491 !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 4 : Very fast ice ' ) 492 !WRITE(numout,*) ' ice strength : ', strength(ji,jj) 493 !WRITE(numout,*) ' oceanic stress utau : ', utau(ji,jj) 494 !WRITE(numout,*) ' oceanic stress vtau : ', vtau(ji,jj) 495 !WRITE(numout,*) ' sea-ice stress utau_ice : ', utau_ice(ji,jj) 496 !WRITE(numout,*) ' sea-ice stress vtau_ice : ', vtau_ice(ji,jj) 497 !WRITE(numout,*) ' oceanic speed u : ', u_oce(ji,jj) 498 !WRITE(numout,*) ' oceanic speed v : ', v_oce(ji,jj) 499 !WRITE(numout,*) ' sst : ', sst_m(ji,jj) 500 !WRITE(numout,*) ' sss : ', sss_m(ji,jj) 501 !WRITE(numout,*) 502 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 503 ENDIF 504 END DO 505 END DO 506 507 ! Alert if there is ice on continents 508 ialert_id = 6 ! reference number of this alert 509 cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert 510 DO jj = 1, jpj 511 DO ji = 1, jpi 512 IF( tms(ji,jj) <= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN 513 !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 6 : Ice on continents ' ) 514 !WRITE(numout,*) ' masks s, u, v : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj) 515 !WRITE(numout,*) ' sst : ', sst_m(ji,jj) 516 !WRITE(numout,*) ' sss : ', sss_m(ji,jj) 517 !WRITE(numout,*) ' at_i(ji,jj) : ', at_i(ji,jj) 518 !WRITE(numout,*) ' v_ice(ji,jj) : ', v_ice(ji,jj) 519 !WRITE(numout,*) ' v_ice(ji,jj-1) : ', v_ice(ji,jj-1) 520 !WRITE(numout,*) ' u_ice(ji-1,jj) : ', u_ice(ji-1,jj) 521 !WRITE(numout,*) ' u_ice(ji,jj) : ', v_ice(ji,jj) 522 ! 523 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 524 ENDIF 525 END DO 526 END DO 527 528 ! 529 ! ! Alert if very fresh ice 530 ialert_id = 7 ! reference number of this alert 531 cl_alname(ialert_id) = ' Very fresh ice ' ! name of the alert 532 DO jl = 1, jpl 533 DO jj = 1, jpj 534 DO ji = 1, jpi 535 IF( sm_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN 536 ! CALL lim_prt_state(kt,ji,jj,1, ' ALERTE 7 : Very fresh ice ' ) 537 ! WRITE(numout,*) ' sst : ', sst_m(ji,jj) 538 ! WRITE(numout,*) ' sss : ', sss_m(ji,jj) 539 ! WRITE(numout,*) 540 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 541 ENDIF 542 END DO 543 END DO 544 END DO 545 ! 546 547 ! ! Alert if too old ice 548 ialert_id = 9 ! reference number of this alert 549 cl_alname(ialert_id) = ' Very old ice ' ! name of the alert 550 DO jl = 1, jpl 551 DO jj = 1, jpj 552 DO ji = 1, jpi 553 IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. & 554 ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 555 ( a_i(ji,jj,jl) > 0._wp ) ) THEN 556 !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 9 : Wrong ice age ') 557 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 558 ENDIF 559 END DO 560 END DO 561 END DO 562 563 ! Alert on salt flux 564 ialert_id = 5 ! reference number of this alert 565 cl_alname(ialert_id) = ' High salt flux ' ! name of the alert 566 DO jj = 1, jpj 567 DO ji = 1, jpi 568 IF( ABS( sfx (ji,jj) ) .GT. 1.0e-2 ) THEN ! = 1 psu/day for 1m ocean depth 569 !CALL lim_prt_state( kt, ji, jj, 3, ' ALERTE 5 : High salt flux ' ) 570 !DO jl = 1, jpl 571 !WRITE(numout,*) ' Category no: ', jl 572 !WRITE(numout,*) ' a_i : ', a_i (ji,jj,jl) , ' a_i_b : ', a_i_b (ji,jj,jl) 573 !WRITE(numout,*) ' d_a_i_trp : ', d_a_i_trp(ji,jj,jl) , ' d_a_i_thd : ', d_a_i_thd(ji,jj,jl) 574 !WRITE(numout,*) ' v_i : ', v_i (ji,jj,jl) , ' v_i_b : ', v_i_b (ji,jj,jl) 575 !WRITE(numout,*) ' d_v_i_trp : ', d_v_i_trp(ji,jj,jl) , ' d_v_i_thd : ', d_v_i_thd(ji,jj,jl) 576 !WRITE(numout,*) ' ' 577 !END DO 578 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 579 ENDIF 580 END DO 581 END DO 582 583 ! Alert if qns very big 584 ialert_id = 8 ! reference number of this alert 585 cl_alname(ialert_id) = ' fnsolar very big ' ! name of the alert 586 DO jj = 1, jpj 587 DO ji = 1, jpi 588 IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 589 ! 590 !WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux' 591 !WRITE(numout,*) ' ji, jj : ', ji, jj 592 !WRITE(numout,*) ' qns : ', qns(ji,jj) 593 !WRITE(numout,*) ' sst : ', sst_m(ji,jj) 594 !WRITE(numout,*) ' sss : ', sss_m(ji,jj) 595 ! 596 !CALL lim_prt_state( kt, ji, jj, 2, ' ') 597 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 598 ! 599 ENDIF 600 END DO 601 END DO 602 !+++++ 603 604 ! Alert if very warm ice 605 ialert_id = 10 ! reference number of this alert 606 cl_alname(ialert_id) = ' Very warm ice ' ! name of the alert 607 inb_alp(ialert_id) = 0 608 DO jl = 1, jpl 609 DO jk = 1, nlay_i 610 DO jj = 1, jpj 611 DO ji = 1, jpi 612 ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt 613 IF( t_i(ji,jj,jk,jl) >= ztmelts .AND. v_i(ji,jj,jl) > 1.e-10 & 614 & .AND. a_i(ji,jj,jl) > 0._wp ) THEN 615 !WRITE(numout,*) ' ALERTE 10 : Very warm ice' 616 !WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl 617 !WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl) 618 !WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl) 619 !WRITE(numout,*) ' s_i : ', s_i(ji,jj,jk,jl) 620 !WRITE(numout,*) ' ztmelts : ', ztmelts 621 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 622 ENDIF 623 END DO 624 END DO 625 END DO 626 END DO 627 628 ! sum of the alerts on all processors 629 IF( lk_mpp ) THEN 630 DO ialert_id = 1, inb_altests 631 CALL mpp_sum(inb_alp(ialert_id)) 632 END DO 633 ENDIF 634 635 ! print alerts 636 IF( lwp ) THEN 637 ialert_id = 1 ! reference number of this alert 638 cl_alname(ialert_id) = ' NO alerte 1 ' ! name of the alert 639 WRITE(numout,*) ' time step ',kt 640 WRITE(numout,*) ' All alerts at the end of ice model ' 641 DO ialert_id = 1, inb_altests 642 WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! ' 643 END DO 644 ENDIF 645 ! 646 END SUBROUTINE lim_ctl 647 648 649 SUBROUTINE lim_prt_state( kt, ki, kj, kn, cd1 ) 650 !!----------------------------------------------------------------------- 651 !! *** ROUTINE lim_prt_state *** 652 !! 653 !! ** Purpose : Writes global ice state on the (i,j) point 654 !! in ocean.ouput 655 !! 3 possibilities exist 656 !! n = 1/-1 -> simple ice state (plus Mechanical Check if -1) 657 !! n = 2 -> exhaustive state 658 !! n = 3 -> ice/ocean salt fluxes 659 !! 660 !! ** input : point coordinates (i,j) 661 !! n : number of the option 662 !!------------------------------------------------------------------- 663 INTEGER , INTENT(in) :: kt ! ocean time step 664 INTEGER , INTENT(in) :: ki, kj, kn ! ocean gridpoint indices 665 CHARACTER(len=*), INTENT(in) :: cd1 ! 666 !! 667 INTEGER :: jl, ji, jj 668 !!------------------------------------------------------------------- 669 670 DO ji = mi0(ki), mi1(ki) 671 DO jj = mj0(kj), mj1(kj) 672 673 WRITE(numout,*) ' time step ',kt,' ',cd1 ! print title 674 675 !---------------- 676 ! Simple state 677 !---------------- 678 679 IF ( kn == 1 .OR. kn == -1 ) THEN 680 WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj 681 WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 682 WRITE(numout,*) ' Simple state ' 683 WRITE(numout,*) ' masks s,u,v : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj) 684 WRITE(numout,*) ' lat - long : ', gphit(ji,jj), glamt(ji,jj) 685 WRITE(numout,*) ' Time step : ', numit 686 WRITE(numout,*) ' - Ice drift ' 687 WRITE(numout,*) ' ~~~~~~~~~~~ ' 688 WRITE(numout,*) ' u_ice(i-1,j) : ', u_ice(ji-1,jj) 689 WRITE(numout,*) ' u_ice(i ,j) : ', u_ice(ji,jj) 690 WRITE(numout,*) ' v_ice(i ,j-1): ', v_ice(ji,jj-1) 691 WRITE(numout,*) ' v_ice(i ,j) : ', v_ice(ji,jj) 692 WRITE(numout,*) ' strength : ', strength(ji,jj) 693 WRITE(numout,*) 694 WRITE(numout,*) ' - Cell values ' 695 WRITE(numout,*) ' ~~~~~~~~~~~ ' 696 WRITE(numout,*) ' cell area : ', area(ji,jj) 697 WRITE(numout,*) ' at_i : ', at_i(ji,jj) 698 WRITE(numout,*) ' vt_i : ', vt_i(ji,jj) 699 WRITE(numout,*) ' vt_s : ', vt_s(ji,jj) 700 DO jl = 1, jpl 701 WRITE(numout,*) ' - Category (', jl,')' 702 WRITE(numout,*) ' a_i : ', a_i(ji,jj,jl) 703 WRITE(numout,*) ' ht_i : ', ht_i(ji,jj,jl) 704 WRITE(numout,*) ' ht_s : ', ht_s(ji,jj,jl) 705 WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl) 706 WRITE(numout,*) ' v_s : ', v_s(ji,jj,jl) 707 WRITE(numout,*) ' e_s : ', e_s(ji,jj,1,jl)/1.0e9 708 WRITE(numout,*) ' e_i : ', e_i(ji,jj,1:nlay_i,jl)/1.0e9 709 WRITE(numout,*) ' t_su : ', t_su(ji,jj,jl) 710 WRITE(numout,*) ' t_snow : ', t_s(ji,jj,1,jl) 711 WRITE(numout,*) ' t_i : ', t_i(ji,jj,1:nlay_i,jl) 712 WRITE(numout,*) ' sm_i : ', sm_i(ji,jj,jl) 713 WRITE(numout,*) ' smv_i : ', smv_i(ji,jj,jl) 714 WRITE(numout,*) 715 END DO 716 ENDIF 717 IF( kn == -1 ) THEN 718 WRITE(numout,*) ' Mechanical Check ************** ' 719 WRITE(numout,*) ' Check what means ice divergence ' 720 WRITE(numout,*) ' Total ice concentration ', at_i (ji,jj) 721 WRITE(numout,*) ' Total lead fraction ', ato_i(ji,jj) 722 WRITE(numout,*) ' Sum of both ', ato_i(ji,jj) + at_i(ji,jj) 723 WRITE(numout,*) ' Sum of both minus 1 ', ato_i(ji,jj) + at_i(ji,jj) - 1.00 724 ENDIF 725 726 727 !-------------------- 728 ! Exhaustive state 729 !-------------------- 730 731 IF ( kn .EQ. 2 ) THEN 732 WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj 733 WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 734 WRITE(numout,*) ' Exhaustive state ' 735 WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj) 736 WRITE(numout,*) ' Time step ', numit 737 WRITE(numout,*) 738 WRITE(numout,*) ' - Cell values ' 739 WRITE(numout,*) ' ~~~~~~~~~~~ ' 740 WRITE(numout,*) ' cell area : ', area(ji,jj) 741 WRITE(numout,*) ' at_i : ', at_i(ji,jj) 742 WRITE(numout,*) ' vt_i : ', vt_i(ji,jj) 743 WRITE(numout,*) ' vt_s : ', vt_s(ji,jj) 744 WRITE(numout,*) ' u_ice(i-1,j) : ', u_ice(ji-1,jj) 745 WRITE(numout,*) ' u_ice(i ,j) : ', u_ice(ji,jj) 746 WRITE(numout,*) ' v_ice(i ,j-1): ', v_ice(ji,jj-1) 747 WRITE(numout,*) ' v_ice(i ,j) : ', v_ice(ji,jj) 748 WRITE(numout,*) ' strength : ', strength(ji,jj) 749 WRITE(numout,*) ' d_u_ice_dyn : ', d_u_ice_dyn(ji,jj), ' d_v_ice_dyn : ', d_v_ice_dyn(ji,jj) 750 WRITE(numout,*) ' u_ice_b : ', u_ice_b(ji,jj) , ' v_ice_b : ', v_ice_b(ji,jj) 751 WRITE(numout,*) 752 753 DO jl = 1, jpl 754 WRITE(numout,*) ' - Category (',jl,')' 755 WRITE(numout,*) ' ~~~~~~~~ ' 756 WRITE(numout,*) ' ht_i : ', ht_i(ji,jj,jl) , ' ht_s : ', ht_s(ji,jj,jl) 757 WRITE(numout,*) ' t_i : ', t_i(ji,jj,1:nlay_i,jl) 758 WRITE(numout,*) ' t_su : ', t_su(ji,jj,jl) , ' t_s : ', t_s(ji,jj,1,jl) 759 WRITE(numout,*) ' sm_i : ', sm_i(ji,jj,jl) , ' o_i : ', o_i(ji,jj,jl) 760 WRITE(numout,*) ' a_i : ', a_i(ji,jj,jl) , ' a_i_b : ', a_i_b(ji,jj,jl) 761 WRITE(numout,*) ' d_a_i_trp : ', d_a_i_trp(ji,jj,jl) , ' d_a_i_thd : ', d_a_i_thd(ji,jj,jl) 762 WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl) , ' v_i_b : ', v_i_b(ji,jj,jl) 763 WRITE(numout,*) ' d_v_i_trp : ', d_v_i_trp(ji,jj,jl) , ' d_v_i_thd : ', d_v_i_thd(ji,jj,jl) 764 WRITE(numout,*) ' v_s : ', v_s(ji,jj,jl) , ' v_s_b : ', v_s_b(ji,jj,jl) 765 WRITE(numout,*) ' d_v_s_trp : ', d_v_s_trp(ji,jj,jl) , ' d_v_s_thd : ', d_v_s_thd(ji,jj,jl) 766 WRITE(numout,*) ' e_i1 : ', e_i(ji,jj,1,jl)/1.0e9 , ' ei1 : ', e_i_b(ji,jj,1,jl)/1.0e9 767 WRITE(numout,*) ' de_i1_trp : ', d_e_i_trp(ji,jj,1,jl)/1.0e9, ' de_i1_thd : ', d_e_i_thd(ji,jj,1,jl)/1.0e9 768 WRITE(numout,*) ' e_i2 : ', e_i(ji,jj,2,jl)/1.0e9 , ' ei2_b : ', e_i_b(ji,jj,2,jl)/1.0e9 769 WRITE(numout,*) ' de_i2_trp : ', d_e_i_trp(ji,jj,2,jl)/1.0e9, ' de_i2_thd : ', d_e_i_thd(ji,jj,2,jl)/1.0e9 770 WRITE(numout,*) ' e_snow : ', e_s(ji,jj,1,jl) , ' e_snow_b : ', e_s_b(ji,jj,1,jl) 771 WRITE(numout,*) ' d_e_s_trp : ', d_e_s_trp(ji,jj,1,jl) , ' d_e_s_thd : ', d_e_s_thd(ji,jj,1,jl) 772 WRITE(numout,*) ' smv_i : ', smv_i(ji,jj,jl) , ' smv_i_b : ', smv_i_b(ji,jj,jl) 773 WRITE(numout,*) ' d_smv_i_trp: ', d_smv_i_trp(ji,jj,jl) , ' d_smv_i_thd: ', d_smv_i_thd(ji,jj,jl) 774 WRITE(numout,*) ' oa_i : ', oa_i(ji,jj,jl) , ' oa_i_b : ', oa_i_b(ji,jj,jl) 775 WRITE(numout,*) ' d_oa_i_trp : ', d_oa_i_trp(ji,jj,jl) , ' d_oa_i_thd : ', d_oa_i_thd(ji,jj,jl) 776 END DO !jl 777 778 WRITE(numout,*) 779 WRITE(numout,*) ' - Heat / FW fluxes ' 780 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ ' 781 WRITE(numout,*) ' - Heat fluxes in and out the ice ***' 782 WRITE(numout,*) ' qsr_ini : ', pfrld(ji,jj) * qsr(ji,jj) + SUM( a_i_b(ji,jj,:) * qsr_ice(ji,jj,:) ) 783 WRITE(numout,*) ' qns_ini : ', pfrld(ji,jj) * qns(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) ) 784 WRITE(numout,*) 785 WRITE(numout,*) 786 WRITE(numout,*) ' sst : ', sst_m(ji,jj) 787 WRITE(numout,*) ' sss : ', sss_m(ji,jj) 788 WRITE(numout,*) 789 WRITE(numout,*) ' - Stresses ' 790 WRITE(numout,*) ' ~~~~~~~~ ' 791 WRITE(numout,*) ' utau_ice : ', utau_ice(ji,jj) 792 WRITE(numout,*) ' vtau_ice : ', vtau_ice(ji,jj) 793 WRITE(numout,*) ' utau : ', utau (ji,jj) 794 WRITE(numout,*) ' vtau : ', vtau (ji,jj) 795 WRITE(numout,*) ' oc. vel. u : ', u_oce (ji,jj) 796 WRITE(numout,*) ' oc. vel. v : ', v_oce (ji,jj) 797 ENDIF 798 799 !--------------------- 800 ! Salt / heat fluxes 801 !--------------------- 802 803 IF ( kn .EQ. 3 ) THEN 804 WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj 805 WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 806 WRITE(numout,*) ' - Salt / Heat Fluxes ' 807 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ ' 808 WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj) 809 WRITE(numout,*) ' Time step ', numit 810 WRITE(numout,*) 811 WRITE(numout,*) ' - Heat fluxes at bottom interface ***' 812 WRITE(numout,*) ' qsr : ', qsr(ji,jj) 813 WRITE(numout,*) ' qns : ', qns(ji,jj) 814 WRITE(numout,*) 815 WRITE(numout,*) ' hfx_mass : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj) 816 WRITE(numout,*) ' hfx_in : ', hfx_in(ji,jj) 817 WRITE(numout,*) ' hfx_out : ', hfx_out(ji,jj) 818 WRITE(numout,*) ' dhc : ', diag_heat_dhc(ji,jj) 819 WRITE(numout,*) 820 WRITE(numout,*) ' hfx_dyn : ', hfx_dyn(ji,jj) 821 WRITE(numout,*) ' hfx_thd : ', hfx_thd(ji,jj) 822 WRITE(numout,*) ' hfx_res : ', hfx_res(ji,jj) 823 WRITE(numout,*) ' fhtur : ', fhtur(ji,jj) 824 WRITE(numout,*) ' qlead : ', qlead(ji,jj) * r1_rdtice 825 WRITE(numout,*) 826 WRITE(numout,*) ' - Salt fluxes at bottom interface ***' 827 WRITE(numout,*) ' emp : ', emp (ji,jj) 828 WRITE(numout,*) ' sfx : ', sfx (ji,jj) 829 WRITE(numout,*) ' sfx_res : ', sfx_res(ji,jj) 830 WRITE(numout,*) ' sfx_bri : ', sfx_bri(ji,jj) 831 WRITE(numout,*) ' sfx_dyn : ', sfx_dyn(ji,jj) 832 WRITE(numout,*) 833 WRITE(numout,*) ' - Momentum fluxes ' 834 WRITE(numout,*) ' utau : ', utau(ji,jj) 835 WRITE(numout,*) ' vtau : ', vtau(ji,jj) 836 ENDIF 837 WRITE(numout,*) ' ' 838 ! 839 END DO 840 END DO 841 ! 842 END SUBROUTINE lim_prt_state 843 549 550 SUBROUTINE sbc_lim_bef 551 !!---------------------------------------------------------------------- 552 !! *** ROUTINE sbc_lim_bef *** 553 !! 554 !! ** purpose : store ice variables at "before" time step 555 !!---------------------------------------------------------------------- 556 a_i_b (:,:,:) = a_i (:,:,:) ! ice area 557 e_i_b (:,:,:,:) = e_i (:,:,:,:) ! ice thermal energy 558 v_i_b (:,:,:) = v_i (:,:,:) ! ice volume 559 v_s_b (:,:,:) = v_s (:,:,:) ! snow volume 560 e_s_b (:,:,:,:) = e_s (:,:,:,:) ! snow thermal energy 561 smv_i_b(:,:,:) = smv_i(:,:,:) ! salt content 562 oa_i_b (:,:,:) = oa_i (:,:,:) ! areal age content 563 u_ice_b(:,:) = u_ice(:,:) 564 v_ice_b(:,:) = v_ice(:,:) 565 566 END SUBROUTINE sbc_lim_bef 567 568 SUBROUTINE sbc_lim_diag0 569 !!---------------------------------------------------------------------- 570 !! *** ROUTINE sbc_lim_diag0 *** 571 !! 572 !! ** purpose : set ice-ocean and ice-atm. fluxes to zeros at the beggining 573 !! of the time step 574 !!---------------------------------------------------------------------- 575 sfx (:,:) = 0._wp ; 576 sfx_bri(:,:) = 0._wp ; 577 sfx_sni(:,:) = 0._wp ; sfx_opw(:,:) = 0._wp 578 sfx_bog(:,:) = 0._wp ; sfx_dyn(:,:) = 0._wp 579 sfx_bom(:,:) = 0._wp ; sfx_sum(:,:) = 0._wp 580 sfx_res(:,:) = 0._wp 581 582 wfx_snw(:,:) = 0._wp ; wfx_ice(:,:) = 0._wp 583 wfx_sni(:,:) = 0._wp ; wfx_opw(:,:) = 0._wp 584 wfx_bog(:,:) = 0._wp ; wfx_dyn(:,:) = 0._wp 585 wfx_bom(:,:) = 0._wp ; wfx_sum(:,:) = 0._wp 586 wfx_res(:,:) = 0._wp ; wfx_sub(:,:) = 0._wp 587 wfx_spr(:,:) = 0._wp ; 588 589 hfx_thd(:,:) = 0._wp ; 590 hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp 591 hfx_bog(:,:) = 0._wp ; hfx_dyn(:,:) = 0._wp 592 hfx_bom(:,:) = 0._wp ; hfx_sum(:,:) = 0._wp 593 hfx_res(:,:) = 0._wp ; hfx_sub(:,:) = 0._wp 594 hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp 595 hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp 596 hfx_err_dif(:,:) = 0._wp ; 597 598 afx_tot(:,:) = 0._wp ; 599 afx_dyn(:,:) = 0._wp ; afx_thd(:,:) = 0._wp 600 601 diag_heat(:,:) = 0._wp ; diag_smvi(:,:) = 0._wp ; 602 diag_vice(:,:) = 0._wp ; diag_vsnw(:,:) = 0._wp ; 603 604 END SUBROUTINE sbc_lim_diag0 605 844 606 845 607 FUNCTION fice_cell_ave ( ptab ) … … 852 614 853 615 fice_cell_ave (:,:) = 0.0_wp 854 855 616 DO jl = 1, jpl 856 fice_cell_ave (:,:) = fice_cell_ave (:,:) & 857 & + a_i (:,:,jl) * ptab (:,:,jl) 617 fice_cell_ave (:,:) = fice_cell_ave (:,:) + a_i (:,:,jl) * ptab (:,:,jl) 858 618 END DO 859 619 … … 869 629 870 630 fice_ice_ave (:,:) = 0.0_wp 871 WHERE ( at_i (:,:) .GT.0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:)631 WHERE ( at_i (:,:) > 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:) 872 632 873 633 END FUNCTION fice_ice_ave … … 882 642 WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt, kblk 883 643 END SUBROUTINE sbc_ice_lim 644 SUBROUTINE sbc_lim_init ! Dummy routine 645 END SUBROUTINE sbc_lim_init 884 646 #endif 885 647 -
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r5307 r5449 101 101 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice ! mean ice albedo 102 102 REAL(wp), DIMENSION(:,:,:), POINTER :: zsist ! ice surface temperature (K) 103 REAL(wp), DIMENSION(:,: ), POINTER :: zutau_ice, zvtau_ice 103 104 !!---------------------------------------------------------------------- 104 105 CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )106 105 107 106 IF( kt == nit000 ) THEN … … 124 123 &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1 125 124 # endif 125 126 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) 127 CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 128 126 129 ! Bulk Formulea ! 127 130 !----------------! … … 132 135 DO ji = 2, jpi ! NO vector opt. possible 133 136 u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj ) * umask(ji-1,jj ,1) & 134 & + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj)137 & + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj) 135 138 v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji ,jj-1) * vmask(ji ,jj-1,1) & 136 & + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj)139 & + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj) 137 140 END DO 138 141 END DO … … 158 161 159 162 SELECT CASE( ksbc ) 160 CASE( jp_core , jp_ cpl ) ! CORE and COUPLED bulk formulations163 CASE( jp_core , jp_purecpl ) ! CORE and COUPLED bulk formulations 161 164 162 165 ! albedo depends on cloud fraction because of non-linear spectral effects … … 182 185 SELECT CASE( ksbc ) 183 186 CASE( jp_clio ) ! CLIO bulk formulation 184 CALL blk_ice_clio( zsist, zalb_cs , zalb_os , zalb_ice , & 185 & utau_ice , vtau_ice , qns_ice , qsr_ice, & 186 & qla_ice , dqns_ice , dqla_ice , & 187 & tprecip , sprecip , & 188 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 187 ! CALL blk_ice_clio( zsist, zalb_cs , zalb_os , zalb_ice , & 188 ! & utau_ice , vtau_ice , qns_ice , qsr_ice, & 189 ! & qla_ice , dqns_ice , dqla_ice , & 190 ! & tprecip , sprecip , & 191 ! & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 192 CALL blk_ice_clio_tau 193 CALL blk_ice_clio_flx( zsist, zalb_cs, zalb_os, zalb_ice ) 189 194 190 195 CASE( jp_core ) ! CORE bulk formulation 191 CALL blk_ice_core( zsist, u_ice , v_ice , zalb_ice , & 192 & utau_ice , vtau_ice , qns_ice , qsr_ice, & 193 & qla_ice , dqns_ice , dqla_ice , & 194 & tprecip , sprecip , & 195 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 196 IF( ltrcdm2dc_ice ) CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl ) 197 198 CASE( jp_cpl ) ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 196 CALL blk_ice_core_tau 197 CALL blk_ice_core_flx( zsist, zalb_ice ) 198 199 CASE( jp_purecpl ) ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 199 200 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 200 201 END SELECT 202 203 IF( ln_mixcpl) THEN 204 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 205 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 206 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 207 ENDIF 201 208 202 209 CALL iom_put( 'utau_ice', utau_ice ) ! Wind stress over ice along i-axis at I-point … … 228 235 END IF 229 236 ! ! Ice surface fluxes in coupled mode 230 IF( ksbc == jp_cpl ) THEN237 IF( ln_cpl ) THEN ! pure coupled and mixed forced-coupled configurations 231 238 a_i(:,:,1)=fr_i 232 239 CALL sbc_cpl_ice_flx( frld, & 233 240 ! optional arguments, used only in 'mixed oce-ice' case 234 & palbi = zalb_ice, psst = sst_m, pist =zsist )241 & palbi=zalb_ice, psst=sst_m, pist=zsist ) 235 242 sprecip(:,:) = - emp_ice(:,:) ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 236 243 ENDIF 237 244 CALL lim_thd_2 ( kt ) ! Ice thermodynamics 238 245 CALL lim_sbc_flx_2 ( kt ) ! update surface ocean mass, heat & salt fluxes 239 #if defined key_top240 IF( ltrcdm2dc_ice )CALL lim_bio_meanqsr_2241 #endif242 246 243 247 IF( .NOT. lk_mpp )THEN … … 253 257 IF( .NOT. Agrif_Root() ) CALL agrif_update_lim2( kt ) 254 258 # endif 259 ! 260 CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice) 261 CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 255 262 ! 256 263 ENDIF ! End sea-ice time step only … … 264 271 IF( ln_limdyn ) CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 265 272 ! 266 CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )267 !268 273 END SUBROUTINE sbc_ice_lim_2 269 274 -
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
- Property svn:keywords set to Id
r5307 r5449 7 7 !! History : 3.2 ! 2011-02 (C.Harris ) Original code isf cav 8 8 !! X.X ! 2006-02 (C. Wang ) Original code bg03 9 !! 3.4 ! 2013-03 (P. Mathiot) Merging 9 !! 3.4 ! 2013-03 (P. Mathiot) Merging + parametrization 10 10 !!---------------------------------------------------------------------- 11 11 … … 37 37 38 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: risf_tsc_b, risf_tsc 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwfisf_b, fwfisf !: evaporation damping [kg/m2/s] 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qisf !: net heat flux from ice shelf 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qisf !: net heat flux from ice shelf 41 40 REAL(wp), PUBLIC :: rn_hisf_tbl !: thickness of top boundary layer [m] 42 41 LOGICAL , PUBLIC :: ln_divisf !: flag to correct divergence … … 309 308 sbc_isf_alloc = 0 ! set to zero if no array to be allocated 310 309 IF( .NOT. ALLOCATED( qisf ) ) THEN 311 ALLOCATE( risf_tsc(jpi,jpj,jpts), risf_tsc_b(jpi,jpj,jpts) , & 312 & qisf(jpi,jpj) , fwfisf(jpi,jpj) , fwfisf_b(jpi,jpj) , & 313 & rhisf_tbl(jpi,jpj), r1_hisf_tbl(jpi,jpj), rzisf_tbl(jpi,jpj) , & 314 & ttbl(jpi,jpj) , stbl(jpi,jpj) , utbl(jpi,jpj) , & 315 & vtbl(jpi, jpj) , risfLeff(jpi,jpj) , rhisf_tbl_0(jpi,jpj), & 316 & ralpha(jpi,jpj) , misfkt(jpi,jpj) , misfkb(jpi,jpj) , & 310 ALLOCATE( risf_tsc(jpi,jpj,jpts), risf_tsc_b(jpi,jpj,jpts), qisf(jpi,jpj) , & 311 & rhisf_tbl(jpi,jpj) , r1_hisf_tbl(jpi,jpj), rzisf_tbl(jpi,jpj) , & 312 & ttbl(jpi,jpj) , stbl(jpi,jpj) , utbl(jpi,jpj) , & 313 & vtbl(jpi, jpj) , risfLeff(jpi,jpj) , rhisf_tbl_0(jpi,jpj), & 314 & ralpha(jpi,jpj) , misfkt(jpi,jpj) , misfkb(jpi,jpj) , & 317 315 & STAT= sbc_isf_alloc ) 318 316 ! … … 563 561 CALL iom_put('isfgammat', zgammat2d) 564 562 CALL iom_put('isfgammas', zgammas2d) 565 ! 566 !CALL wrk_dealloc( jpi,jpj, zfrz,zpress,zti, zqisf, zfwfisf ) 563 ! 567 564 CALL wrk_dealloc( jpi,jpj, zfrz,zpress,zti, zgammat2d, zgammas2d ) 568 565 ! -
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r5307 r5449 13 13 !! 3.4 ! 2011-11 (C. Harris) CICE added as an option 14 14 !! 3.5 ! 2012-11 (A. Coward, G. Madec) Rethink of heat, mass and salt surface fluxes 15 !! 3.6 ! 2014-11 (P. Mathiot, C. Harris) add ice shelves melting 15 16 !!---------------------------------------------------------------------- 16 17 … … 23 24 USE phycst ! physical constants 24 25 USE sbc_oce ! Surface boundary condition: ocean fields 26 USE trc_oce ! shared ocean-passive tracers variables 25 27 USE sbc_ice ! Surface boundary condition: ice fields 26 28 USE sbcdcy ! surface boundary condition: diurnal cycle … … 37 39 USE sbcice_cice ! surface boundary condition: CICE sea-ice model 38 40 USE sbccpl ! surface boundary condition: coupled florulation 41 USE cpl_oasis3 ! OASIS routines for coupling 39 42 USE sbcssr ! surface boundary condition: sea surface restoring 40 43 USE sbcrnf ! surface boundary condition: runoffs … … 82 85 INTEGER :: icpt ! local integer 83 86 !! 84 NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx, ln_blk_clio, ln_blk_core, & 85 & ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc , ln_rnf, & 86 & ln_ssr , nn_isf , nn_fwb , ln_cdgw , ln_wave , ln_sdw, nn_lsm, nn_limflx 87 NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx, ln_blk_clio, ln_blk_core, ln_mixcpl, & 88 & ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc , ln_rnf , & 89 & ln_ssr , nn_isf , nn_fwb, ln_cdgw , ln_wave , ln_sdw , & 90 & nn_lsm , nn_limflx , nn_components, ln_cpl 87 91 INTEGER :: ios 92 INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3, jpm 93 LOGICAL :: ll_purecpl 88 94 !!---------------------------------------------------------------------- 89 95 … … 113 119 nn_ice = 0 114 120 ENDIF 115 121 116 122 IF(lwp) THEN ! Control print 117 123 WRITE(numout,*) ' Namelist namsbc (partly overwritten with CPP key setting)' … … 123 129 WRITE(numout,*) ' CORE bulk formulation ln_blk_core = ', ln_blk_core 124 130 WRITE(numout,*) ' MFS bulk formulation ln_blk_mfs = ', ln_blk_mfs 125 WRITE(numout,*) ' coupled formulation (T if key_oasis3) lk_cpl = ', lk_cpl 131 WRITE(numout,*) ' ocean-atmosphere coupled formulation ln_cpl = ', ln_cpl 132 WRITE(numout,*) ' forced-coupled mixed formulation ln_mixcpl = ', ln_mixcpl 133 WRITE(numout,*) ' OASIS coupling (with atm or sas) lk_oasis = ', lk_oasis 134 WRITE(numout,*) ' components of your executable nn_components = ', nn_components 126 135 WRITE(numout,*) ' Multicategory heat flux formulation (LIM3) nn_limflx = ', nn_limflx 127 136 WRITE(numout,*) ' Misc. options of sbc : ' … … 150 159 END SELECT 151 160 ! 152 #if defined key_top && ! defined key_offline 153 ltrcdm2dc = (ln_dm2dc .AND. ln_blk_core .AND. nn_ice==2) 154 IF( ltrcdm2dc )THEN 155 IF(lwp)THEN 156 WRITE(numout,*)"analytical diurnal cycle, core bulk formulation and LIM2 use: " 157 WRITE(numout,*)"Diurnal cycle on physics but not in passive tracers" 158 ENDIF 159 ENDIF 160 #else 161 ltrcdm2dc = .FALSE. 162 #endif 163 164 ! 161 IF ( nn_components /= jp_iam_nemo .AND. .NOT. lk_oasis ) & 162 & CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' ) 163 IF ( nn_components == jp_iam_opa .AND. ln_cpl ) & 164 & CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' ) 165 IF ( nn_components == jp_iam_opa .AND. ln_mixcpl ) & 166 & CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' ) 167 IF ( ln_cpl .AND. .NOT. lk_oasis ) & 168 & CALL ctl_stop( 'STOP', 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' ) 169 IF( ln_mixcpl .AND. .NOT. lk_oasis ) & 170 & CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires the cpp key key_oasis3' ) 171 IF( ln_mixcpl .AND. .NOT. ln_cpl ) & 172 & CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires ln_cpl = T' ) 173 IF( ln_mixcpl .AND. nn_components /= jp_iam_nemo ) & 174 & CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) is not yet working with sas-opa coupling via oasis' ) 175 165 176 ! ! allocate sbc arrays 166 177 IF( sbc_oce_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' ) 167 178 168 179 ! ! Checks: 169 IF( .NOT. ln_rnf ) THEN ! no specific treatment in vicinity of river mouths170 ln_rnf_mouth = .false.171 IF( sbc_rnf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_rnf arrays' )172 nkrnf = 0173 rnf (:,:) = 0.0_wp174 rnf_b (:,:) = 0.0_wp175 rnfmsk (:,:) = 0.0_wp176 rnfmsk_z(:) = 0.0_wp177 ENDIF178 180 IF( nn_isf .EQ. 0 ) THEN ! no specific treatment in vicinity of ice shelf 179 181 IF( sbc_isf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' ) 180 182 fwfisf (:,:) = 0.0_wp 183 fwfisf_b(:,:) = 0.0_wp 181 184 END IF 182 IF( nn_ice == 0 ) fr_i(:,:) = 0.e0! no ice in the domain, ice fraction is always zero185 IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa ) fr_i(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero 183 186 184 187 sfx(:,:) = 0.0_wp ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero) … … 190 193 191 194 ! ! restartability 192 IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR. & 193 MOD( nstock , nn_fsbc) /= 0 ) THEN 194 WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock, & 195 & ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')' 196 CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' ) 197 ENDIF 198 ! 199 IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 ) & 200 & CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 201 ! 202 IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) ) & 195 IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) ) & 203 196 & CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' ) 204 IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. l k_cpl ) ) &205 & CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or l k_cpl' )197 IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. ln_cpl ) ) & 198 & CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or ln_cpl' ) 206 199 IF( nn_ice == 4 .AND. lk_agrif ) & 207 200 & CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' ) … … 210 203 IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) ) & 211 204 & WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3' 212 IF( ( nn_ice == 3 ) .AND. ( l k_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) ) &205 IF( ( nn_ice == 3 ) .AND. ( ln_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) ) & 213 206 & CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 214 IF( ( nn_ice == 3 ) .AND. ( .NOT. l k_cpl ) .AND. ( nn_limflx == 2 ) ) &207 IF( ( nn_ice == 3 ) .AND. ( .NOT. ln_cpl ) .AND. ( nn_limflx == 2 ) ) & 215 208 & CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' ) 216 209 217 210 IF( ln_dm2dc ) nday_qsr = -1 ! initialisation flag 218 211 219 IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) ) &212 IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) .AND. nn_components /= jp_iam_opa ) & 220 213 & CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' ) 221 214 222 IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) ) < 8 ) ) &223 & CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )224 225 215 IF ( ln_wave ) THEN 226 216 !Activated wave module but neither drag nor stokes drift activated … … 236 226 & asked coupling with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ') 237 227 ENDIF 238 239 228 ! ! Choice of the Surface Boudary Condition (set nsbc) 229 ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl 230 ! 240 231 icpt = 0 241 IF( ln_ana ) THEN ; nsbc = jp_ana ; icpt = icpt + 1 ; ENDIF ! analytical formulation 242 IF( ln_flx ) THEN ; nsbc = jp_flx ; icpt = icpt + 1 ; ENDIF ! flux formulation 243 IF( ln_blk_clio ) THEN ; nsbc = jp_clio ; icpt = icpt + 1 ; ENDIF ! CLIO bulk formulation 244 IF( ln_blk_core ) THEN ; nsbc = jp_core ; icpt = icpt + 1 ; ENDIF ! CORE bulk formulation 245 IF( ln_blk_mfs ) THEN ; nsbc = jp_mfs ; icpt = icpt + 1 ; ENDIF ! MFS bulk formulation 246 IF( lk_cpl ) THEN ; nsbc = jp_cpl ; icpt = icpt + 1 ; ENDIF ! Coupled formulation 247 IF( cp_cfg == 'gyre') THEN ; nsbc = jp_gyre ; ENDIF ! GYRE analytical formulation 248 IF( lk_esopa ) nsbc = jp_esopa ! esopa test, ALL formulations 232 IF( ln_ana ) THEN ; nsbc = jp_ana ; icpt = icpt + 1 ; ENDIF ! analytical formulation 233 IF( ln_flx ) THEN ; nsbc = jp_flx ; icpt = icpt + 1 ; ENDIF ! flux formulation 234 IF( ln_blk_clio ) THEN ; nsbc = jp_clio ; icpt = icpt + 1 ; ENDIF ! CLIO bulk formulation 235 IF( ln_blk_core ) THEN ; nsbc = jp_core ; icpt = icpt + 1 ; ENDIF ! CORE bulk formulation 236 IF( ln_blk_mfs ) THEN ; nsbc = jp_mfs ; icpt = icpt + 1 ; ENDIF ! MFS bulk formulation 237 IF( ll_purecpl ) THEN ; nsbc = jp_purecpl ; icpt = icpt + 1 ; ENDIF ! Pure Coupled formulation 238 IF( cp_cfg == 'gyre') THEN ; nsbc = jp_gyre ; ENDIF ! GYRE analytical formulation 239 IF( nn_components == jp_iam_opa ) & 240 & THEN ; nsbc = jp_none ; icpt = icpt + 1 ; ENDIF ! opa coupling via SAS module 241 IF( lk_esopa ) nsbc = jp_esopa ! esopa test, ALL formulations 249 242 ! 250 243 IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN … … 257 250 IF(lwp) THEN 258 251 WRITE(numout,*) 259 IF( nsbc == jp_esopa ) WRITE(numout,*) ' ESOPA test All surface boundary conditions' 260 IF( nsbc == jp_gyre ) WRITE(numout,*) ' GYRE analytical formulation' 261 IF( nsbc == jp_ana ) WRITE(numout,*) ' analytical formulation' 262 IF( nsbc == jp_flx ) WRITE(numout,*) ' flux formulation' 263 IF( nsbc == jp_clio ) WRITE(numout,*) ' CLIO bulk formulation' 264 IF( nsbc == jp_core ) WRITE(numout,*) ' CORE bulk formulation' 265 IF( nsbc == jp_cpl ) WRITE(numout,*) ' coupled formulation' 266 IF( nsbc == jp_mfs ) WRITE(numout,*) ' MFS Bulk formulation' 267 ENDIF 268 ! 252 IF( nsbc == jp_esopa ) WRITE(numout,*) ' ESOPA test All surface boundary conditions' 253 IF( nsbc == jp_gyre ) WRITE(numout,*) ' GYRE analytical formulation' 254 IF( nsbc == jp_ana ) WRITE(numout,*) ' analytical formulation' 255 IF( nsbc == jp_flx ) WRITE(numout,*) ' flux formulation' 256 IF( nsbc == jp_clio ) WRITE(numout,*) ' CLIO bulk formulation' 257 IF( nsbc == jp_core ) WRITE(numout,*) ' CORE bulk formulation' 258 IF( nsbc == jp_purecpl ) WRITE(numout,*) ' pure coupled formulation' 259 IF( nsbc == jp_mfs ) WRITE(numout,*) ' MFS Bulk formulation' 260 IF( nsbc == jp_none ) WRITE(numout,*) ' OPA coupled to SAS via oasis' 261 IF( ln_mixcpl ) WRITE(numout,*) ' + forced-coupled mixed formulation' 262 IF( nn_components/= jp_iam_nemo ) & 263 & WRITE(numout,*) ' + OASIS coupled SAS' 264 ENDIF 265 ! 266 IF( lk_oasis ) CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before: (1) first time step 267 ! ! (2) the use of nn_fsbc 268 269 ! nn_fsbc initialization if OPA-SAS coupling via OASIS 270 ! sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 271 IF ( nn_components /= jp_iam_nemo ) THEN 272 273 IF ( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt) 274 IF ( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt) 275 ! 276 IF(lwp)THEN 277 WRITE(numout,*) 278 WRITE(numout,*)" OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc 279 WRITE(numout,*) 280 ENDIF 281 ENDIF 282 283 IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR. & 284 MOD( nstock , nn_fsbc) /= 0 ) THEN 285 WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock, & 286 & ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')' 287 CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' ) 288 ENDIF 289 ! 290 IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 ) & 291 & CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 292 ! 293 IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) ) < 8 ) ) & 294 & CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 295 269 296 CALL sbc_ssm_init ! Sea-surface mean fields initialisation 270 297 ! 271 298 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialisation 272 299 ! 300 CALL sbc_rnf_init ! Runof initialisation 301 ! 302 IF( nn_ice == 3 ) CALL sbc_lim_init ! LIM3 initialisation 303 273 304 IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialisation 274 ! 275 IF( nsbc == jp_cpl ) CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before first time step 276 305 277 306 END SUBROUTINE sbc_init 278 307 … … 317 346 ! (caution called before sbc_ssm) 318 347 ! 319 CALL sbc_ssm( kt )! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)320 ! ! averaged over nf_sbc time-step348 IF( nn_components /= jp_iam_sas ) CALL sbc_ssm( kt ) ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 349 ! ! averaged over nf_sbc time-step 321 350 322 351 IF (ln_wave) CALL sbc_wave( kt ) … … 329 358 CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation 330 359 CASE( jp_clio ) ; CALL sbc_blk_clio( kt ) ! bulk formulation : CLIO for the ocean 331 CASE( jp_core ) ; CALL sbc_blk_core( kt ) ! bulk formulation : CORE for the ocean 332 CASE( jp_cpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! coupled formulation 360 CASE( jp_core ) 361 IF( nn_components == jp_iam_sas ) & 362 & CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: SAS receiving fields from OPA 363 CALL sbc_blk_core( kt ) ! bulk formulation : CORE for the ocean 364 ! from oce: sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 365 CASE( jp_purecpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! pure coupled formulation 366 ! 333 367 CASE( jp_mfs ) ; CALL sbc_blk_mfs ( kt ) ! bulk formulation : MFS for the ocean 368 CASE( jp_none ) 369 IF( nn_components == jp_iam_opa ) & 370 CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: OPA receiving fields from SAS 334 371 CASE( jp_esopa ) 335 372 CALL sbc_ana ( kt ) ! ESOPA, test ALL the formulations … … 341 378 END SELECT 342 379 380 IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! forced-coupled mixed formulation after forcing 381 382 343 383 ! !== Misc. Options ==! 344 384 … … 363 403 ! ! (update freshwater fluxes) 364 404 !RBbug do not understand why see ticket 667 365 !clem-bugsal CALL lbc_lnk( emp, 'T', 1. ) 405 !clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why. 406 CALL lbc_lnk( emp, 'T', 1. ) 366 407 ! 367 408 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! … … 404 445 ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b' , qsr ) 405 446 CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp ) 406 CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx)447 CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx ) 407 448 ENDIF 408 449 … … 419 460 CALL iom_put( "qns" , qns ) ! solar heat flux 420 461 CALL iom_put( "qsr" , qsr ) ! solar heat flux 421 IF( nn_ice > 0 ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction462 IF( nn_ice > 0 .OR. nn_components == jp_iam_opa ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction 422 463 CALL iom_put( "taum" , taum ) ! wind stress module 423 464 CALL iom_put( "wspd" , wndm ) ! wind speed module over free ocean or leads in presence of sea-ice -
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r5307 r5449 32 32 33 33 PUBLIC sbc_rnf ! routine call in sbcmod module 34 PUBLIC sbc_rnf_div ! routine called in sshwzvmodule34 PUBLIC sbc_rnf_div ! routine called in divcurl module 35 35 PUBLIC sbc_rnf_alloc ! routine call in sbcmod module 36 36 PUBLIC sbc_rnf_init ! (PUBLIC for TAM) 37 37 ! !!* namsbc_rnf namelist * 38 CHARACTER(len=100), PUBLIC :: cn_dir !: Root directory for location of ssr files 39 LOGICAL , PUBLIC :: ln_rnf_depth !: depth river runoffs attribute specified in a file 40 LOGICAL , PUBLIC :: ln_rnf_tem !: temperature river runoffs attribute specified in a file 38 CHARACTER(len=100) :: cn_dir !: Root directory for location of rnf files 39 LOGICAL :: ln_rnf_depth !: depth river runoffs attribute specified in a file 40 LOGICAL :: ln_rnf_depth_ini !: depth river runoffs computed at the initialisation 41 REAL(wp) :: rn_rnf_max !: maximum value of the runoff climatologie ( ln_rnf_depth_ini = .true ) 42 REAL(wp) :: rn_dep_max !: depth over which runoffs is spread ( ln_rnf_depth_ini = .true ) 43 INTEGER :: nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0) 44 LOGICAL :: ln_rnf_tem !: temperature river runoffs attribute specified in a file 41 45 LOGICAL , PUBLIC :: ln_rnf_sal !: salinity river runoffs attribute specified in a file 42 LOGICAL , PUBLIC :: ln_rnf_emp !: runoffs into a file to be read or already into precipitation43 46 TYPE(FLD_N) , PUBLIC :: sn_rnf !: information about the runoff file to be read 44 TYPE(FLD_N) , PUBLIC:: sn_cnf !: information about the runoff mouth file to be read47 TYPE(FLD_N) :: sn_cnf !: information about the runoff mouth file to be read 45 48 TYPE(FLD_N) :: sn_s_rnf !: information about the salinities of runoff file to be read 46 49 TYPE(FLD_N) :: sn_t_rnf !: information about the temperatures of runoff file to be read 47 50 TYPE(FLD_N) :: sn_dep_rnf !: information about the depth which river inflow affects 48 51 LOGICAL , PUBLIC :: ln_rnf_mouth !: specific treatment in mouths vicinity 49 REAL(wp) , PUBLIC:: rn_hrnf !: runoffs, depth over which enhanced vertical mixing is used52 REAL(wp) :: rn_hrnf !: runoffs, depth over which enhanced vertical mixing is used 50 53 REAL(wp) , PUBLIC :: rn_avt_rnf !: runoffs, value of the additional vertical mixing coef. [m2/s] 51 REAL(wp) , PUBLIC :: rn_rfact !: multiplicative factor for runoff 54 REAL(wp) :: rn_rfact !: multiplicative factor for runoff 55 56 LOGICAL , PUBLIC :: l_rnfcpl = .false. ! runoffs recieved from oasis 52 57 53 58 INTEGER , PUBLIC :: nkrnf = 0 !: nb of levels over which Kz is increased at river mouths … … 58 63 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rnf_tsc_b, rnf_tsc !: before and now T & S runoff contents [K.m/s & PSU.m/s] 59 64 60 TYPE(FLD), PUBLIC,ALLOCATABLE, DIMENSION(:) :: sf_rnf ! structure: river runoff (file information, fields read)61 TYPE(FLD), PUBLIC,ALLOCATABLE, DIMENSION(:) :: sf_s_rnf ! structure: river runoff salinity (file information, fields read)62 TYPE(FLD), PUBLIC,ALLOCATABLE, DIMENSION(:) :: sf_t_rnf ! structure: river runoff temperature (file information, fields read)65 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_rnf ! structure: river runoff (file information, fields read) 66 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_s_rnf ! structure: river runoff salinity (file information, fields read) 67 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_t_rnf ! structure: river runoff temperature (file information, fields read) 63 68 64 69 !! * Substitutions … … 105 110 CALL wrk_alloc( jpi,jpj, ztfrz) 106 111 107 !108 IF( kt == nit000 ) CALL sbc_rnf_init ! Read namelist and allocate structures109 110 112 ! ! ---------------------------------------- ! 111 113 IF( kt /= nit000 ) THEN ! Swap of forcing fields ! … … 116 118 ENDIF 117 119 118 ! !-------------------! 119 IF( .NOT. ln_rnf_emp ) THEN ! Update runoff ! 120 ! !-------------------! 121 ! 122 CALL fld_read ( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provide it at kt 123 IF( ln_rnf_tem ) CALL fld_read ( kt, nn_fsbc, sf_t_rnf ) ! idem for runoffs temperature if required 124 IF( ln_rnf_sal ) CALL fld_read ( kt, nn_fsbc, sf_s_rnf ) ! idem for runoffs salinity if required 125 ! 126 ! Runoff reduction only associated to the ORCA2_LIM configuration 127 ! when reading the NetCDF file runoff_1m_nomask.nc 128 IF( cp_cfg == 'orca' .AND. jp_cfg == 2 ) THEN 129 WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp ) 130 sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1) 120 ! !-------------------! 121 ! ! Update runoff ! 122 ! !-------------------! 123 ! 124 IF( .NOT. l_rnfcpl ) CALL fld_read ( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provide it at kt 125 IF( ln_rnf_tem ) CALL fld_read ( kt, nn_fsbc, sf_t_rnf ) ! idem for runoffs temperature if required 126 IF( ln_rnf_sal ) CALL fld_read ( kt, nn_fsbc, sf_s_rnf ) ! idem for runoffs salinity if required 127 ! 128 ! Runoff reduction only associated to the ORCA2_LIM configuration 129 ! when reading the NetCDF file runoff_1m_nomask.nc 130 IF( cp_cfg == 'orca' .AND. jp_cfg == 2 .AND. .NOT. l_rnfcpl ) THEN 131 WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp ) 132 sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1) 133 END WHERE 134 ENDIF 135 ! 136 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 137 ! 138 IF( .NOT. l_rnfcpl ) rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) ! updated runoff value at time step kt 139 ! 140 ! ! set temperature & salinity content of runoffs 141 IF( ln_rnf_tem ) THEN ! use runoffs temperature data 142 rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 143 WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp ) ! if missing data value use SST as runoffs temperature 144 rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 131 145 END WHERE 132 ENDIF 133 ! 134 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 135 ! 136 rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) ! updated runoff value at time step kt 137 ! 138 ! ! set temperature & salinity content of runoffs 139 IF( ln_rnf_tem ) THEN ! use runoffs temperature data 140 rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 141 WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp ) ! if missing data value use SST as runoffs temperature 142 rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 143 END WHERE 144 WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp ) ! where fwf comes from melting of ice shelves or iceberg 145 ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study) 146 rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp 147 END WHERE 148 ELSE ! use SST as runoffs temperature 149 rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 150 ENDIF 151 ! ! use runoffs salinity data 152 IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 153 ! ! else use S=0 for runoffs (done one for all in the init) 154 IF ( ANY( rnf(:,:) < 0._wp ) ) z_err=1 155 IF(lk_mpp) CALL mpp_sum(z_err) 156 IF( z_err > 0 ) CALL ctl_stop( 'sbc_rnf : negative runnoff values exist' ) 157 ! 158 CALL iom_put( "runoffs", rnf ) ! output runoffs arrays 159 ENDIF 160 ! 161 ENDIF 162 ! 146 WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp ) ! where fwf comes from melting of ice shelves or iceberg 147 ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study) 148 rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp 149 END WHERE 150 ELSE ! use SST as runoffs temperature 151 rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 152 ENDIF 153 ! ! use runoffs salinity data 154 IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 155 ! ! else use S=0 for runoffs (done one for all in the init) 156 CALL iom_put( "runoffs", rnf ) ! output runoffs arrays 157 ENDIF 158 ! 159 ! ! ---------------------------------------- ! 163 160 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 164 161 ! ! ---------------------------------------- ! … … 171 168 ELSE !* no restart: set from nit000 values 172 169 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields set to nit000' 173 174 170 rnf_b (:,: ) = rnf (:,: ) 171 rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 175 172 ENDIF 176 173 ENDIF … … 186 183 CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) ) 187 184 ENDIF 185 ! 188 186 CALL wrk_dealloc( jpi,jpj, ztfrz) 189 187 ! … … 255 253 !!---------------------------------------------------------------------- 256 254 CHARACTER(len=32) :: rn_dep_file ! runoff file name 257 INTEGER :: ji, jj, jk ! dummy loop indices255 INTEGER :: ji, jj, jk, jm ! dummy loop indices 258 256 INTEGER :: ierror, inum ! temporary integer 259 257 INTEGER :: ios ! Local integer output status for namelist read 260 ! 261 NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, & 258 INTEGER :: nbrec ! temporary integer 259 REAL(wp) :: zacoef 260 REAL(wp), DIMENSION(12) :: zrec ! times records 261 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zrnfcl 262 REAL(wp), DIMENSION(:,: ), ALLOCATABLE :: zrnf 263 ! 264 NAMELIST/namsbc_rnf/ cn_dir , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, & 262 265 & sn_rnf, sn_cnf , sn_s_rnf , sn_t_rnf , sn_dep_rnf, & 263 & ln_rnf_mouth , rn_hrnf , rn_avt_rnf, rn_rfact 264 !!---------------------------------------------------------------------- 266 & ln_rnf_mouth , rn_hrnf , rn_avt_rnf, rn_rfact, & 267 & ln_rnf_depth_ini , rn_dep_max , rn_rnf_max, nn_rnf_depth_file 268 !!---------------------------------------------------------------------- 269 ! 270 ! !== allocate runoff arrays 271 IF( sbc_rnf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' ) 272 ! 273 IF( .NOT. ln_rnf ) THEN ! no specific treatment in vicinity of river mouths 274 ln_rnf_mouth = .FALSE. ! default definition needed for example by sbc_ssr or by tra_adv_muscl 275 nkrnf = 0 276 rnf (:,:) = 0.0_wp 277 rnf_b (:,:) = 0.0_wp 278 rnfmsk (:,:) = 0.0_wp 279 rnfmsk_z(:) = 0.0_wp 280 RETURN 281 ENDIF 265 282 ! 266 283 ! ! ============ … … 283 300 WRITE(numout,*) '~~~~~~~ ' 284 301 WRITE(numout,*) ' Namelist namsbc_rnf' 285 WRITE(numout,*) ' runoff in a file to be read ln_rnf_emp = ', ln_rnf_emp286 302 WRITE(numout,*) ' specific river mouths treatment ln_rnf_mouth = ', ln_rnf_mouth 287 303 WRITE(numout,*) ' river mouth additional Kz rn_avt_rnf = ', rn_avt_rnf … … 289 305 WRITE(numout,*) ' multiplicative factor for runoff rn_rfact = ', rn_rfact 290 306 ENDIF 291 !292 307 ! ! ================== 293 308 ! ! Type of runoff 294 309 ! ! ================== 295 ! !== allocate runoff arrays 296 IF( sbc_rnf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' ) 297 ! 298 IF( ln_rnf_emp ) THEN !== runoffs directly provided in the precipitations ==! 299 IF(lwp) WRITE(numout,*) 300 IF(lwp) WRITE(numout,*) ' runoffs directly provided in the precipitations' 301 IF( ln_rnf_depth .OR. ln_rnf_tem .OR. ln_rnf_sal ) THEN 302 CALL ctl_warn( 'runoffs already included in precipitations, so runoff (T,S, depth) attributes will not be used' ) 303 ln_rnf_depth = .FALSE. ; ln_rnf_tem = .FALSE. ; ln_rnf_sal = .FALSE. 304 ENDIF 305 ! 306 ELSE !== runoffs read in a file : set sf_rnf structure ==! 307 ! 310 ! 311 IF( .NOT. l_rnfcpl ) THEN 308 312 ALLOCATE( sf_rnf(1), STAT=ierror ) ! Create sf_rnf structure (runoff inflow) 309 313 IF(lwp) WRITE(numout,*) … … 314 318 ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1) ) 315 319 IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 316 ! ! fill sf_rnf with the namelist (sn_rnf) and control print317 320 CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' ) 318 ! 319 IF( ln_rnf_tem ) THEN ! Create (if required) sf_t_rnf structure 320 IF(lwp) WRITE(numout,*) 321 IF(lwp) WRITE(numout,*) ' runoffs temperatures read in a file' 322 ALLOCATE( sf_t_rnf(1), STAT=ierror ) 323 IF( ierror > 0 ) THEN 324 CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' ) ; RETURN 325 ENDIF 326 ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1) ) 327 IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) ) 328 CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' ) 329 ENDIF 330 ! 331 IF( ln_rnf_sal ) THEN ! Create (if required) sf_s_rnf and sf_t_rnf structures 332 IF(lwp) WRITE(numout,*) 333 IF(lwp) WRITE(numout,*) ' runoffs salinities read in a file' 334 ALLOCATE( sf_s_rnf(1), STAT=ierror ) 335 IF( ierror > 0 ) THEN 336 CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' ) ; RETURN 337 ENDIF 338 ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1) ) 339 IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) ) 340 CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' ) 341 ENDIF 342 ! 343 IF( ln_rnf_depth ) THEN ! depth of runoffs set from a file 344 IF(lwp) WRITE(numout,*) 345 IF(lwp) WRITE(numout,*) ' runoffs depth read in a file' 346 rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 347 IF( .NOT. sn_dep_rnf%ln_clim ) THEN ; WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear ! add year 348 IF( sn_dep_rnf%cltype == 'monthly' ) WRITE(rn_dep_file, '(a,"m",i2)' ) TRIM( rn_dep_file ), nmonth ! add month 349 ENDIF 350 CALL iom_open ( rn_dep_file, inum ) ! open file 351 CALL iom_get ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf ) ! read the river mouth array 352 CALL iom_close( inum ) ! close file 353 ! 354 nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied 355 DO jj = 1, jpj 356 DO ji = 1, jpi 357 IF( h_rnf(ji,jj) > 0._wp ) THEN 358 jk = 2 359 DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1 ; END DO 360 nk_rnf(ji,jj) = jk 361 ELSEIF( h_rnf(ji,jj) == -1._wp ) THEN ; nk_rnf(ji,jj) = 1 362 ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN ; nk_rnf(ji,jj) = mbkt(ji,jj) 363 ELSE 364 CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999' ) 365 WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj) 366 ENDIF 321 ENDIF 322 ! 323 IF( ln_rnf_tem ) THEN ! Create (if required) sf_t_rnf structure 324 IF(lwp) WRITE(numout,*) 325 IF(lwp) WRITE(numout,*) ' runoffs temperatures read in a file' 326 ALLOCATE( sf_t_rnf(1), STAT=ierror ) 327 IF( ierror > 0 ) THEN 328 CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' ) ; RETURN 329 ENDIF 330 ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1) ) 331 IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) ) 332 CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' ) 333 ENDIF 334 ! 335 IF( ln_rnf_sal ) THEN ! Create (if required) sf_s_rnf and sf_t_rnf structures 336 IF(lwp) WRITE(numout,*) 337 IF(lwp) WRITE(numout,*) ' runoffs salinities read in a file' 338 ALLOCATE( sf_s_rnf(1), STAT=ierror ) 339 IF( ierror > 0 ) THEN 340 CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' ) ; RETURN 341 ENDIF 342 ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1) ) 343 IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) ) 344 CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' ) 345 ENDIF 346 ! 347 IF( ln_rnf_depth ) THEN ! depth of runoffs set from a file 348 IF(lwp) WRITE(numout,*) 349 IF(lwp) WRITE(numout,*) ' runoffs depth read in a file' 350 rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 351 IF( .NOT. sn_dep_rnf%ln_clim ) THEN ; WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear ! add year 352 IF( sn_dep_rnf%cltype == 'monthly' ) WRITE(rn_dep_file, '(a,"m",i2)' ) TRIM( rn_dep_file ), nmonth ! add month 353 ENDIF 354 CALL iom_open ( rn_dep_file, inum ) ! open file 355 CALL iom_get ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf ) ! read the river mouth array 356 CALL iom_close( inum ) ! close file 357 ! 358 nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied 359 DO jj = 1, jpj 360 DO ji = 1, jpi 361 IF( h_rnf(ji,jj) > 0._wp ) THEN 362 jk = 2 363 DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1 364 END DO 365 nk_rnf(ji,jj) = jk 366 ELSEIF( h_rnf(ji,jj) == -1._wp ) THEN ; nk_rnf(ji,jj) = 1 367 ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN ; nk_rnf(ji,jj) = mbkt(ji,jj) 368 ELSE 369 CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999' ) 370 WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj) 371 ENDIF 372 END DO 373 END DO 374 DO jj = 1, jpj ! set the associated depth 375 DO ji = 1, jpi 376 h_rnf(ji,jj) = 0._wp 377 DO jk = 1, nk_rnf(ji,jj) 378 h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 367 379 END DO 368 380 END DO 369 DO jj = 1, jpj ! set the associated depth 370 DO ji = 1, jpi 371 h_rnf(ji,jj) = 0._wp 372 DO jk = 1, nk_rnf(ji,jj) 373 h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 381 END DO 382 ! 383 ELSE IF( ln_rnf_depth_ini ) THEN ! runoffs applied at the surface 384 ! 385 IF(lwp) WRITE(numout,*) 386 IF(lwp) WRITE(numout,*) ' depth of runoff computed once from max value of runoff' 387 IF(lwp) WRITE(numout,*) ' max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max 388 IF(lwp) WRITE(numout,*) ' depth over which runoffs is spread rn_dep_max = ', rn_dep_max 389 IF(lwp) WRITE(numout,*) ' create (=1) a runoff depth file or not (=0) nn_rnf_depth_file = ', nn_rnf_depth_file 390 391 CALL iom_open( TRIM( sn_rnf%clname ), inum ) ! open runoff file 392 CALL iom_gettime( inum, zrec, kntime=nbrec) 393 ALLOCATE( zrnfcl(jpi,jpj,nbrec) ) ; ALLOCATE( zrnf(jpi,jpj) ) 394 DO jm = 1, nbrec 395 CALL iom_get( inum, jpdom_data, TRIM( sn_rnf%clvar ), zrnfcl(:,:,jm), jm ) 396 END DO 397 CALL iom_close( inum ) 398 zrnf(:,:) = MAXVAL( zrnfcl(:,:,:), DIM=3 ) ! maximum value in time 399 DEALLOCATE( zrnfcl ) 400 ! 401 h_rnf(:,:) = 1. 402 ! 403 zacoef = rn_dep_max / rn_rnf_max ! coef of linear relation between runoff and its depth (150m for max of runoff) 404 ! 405 WHERE( zrnf(:,:) > 0._wp ) h_rnf(:,:) = zacoef * zrnf(:,:) ! compute depth for all runoffs 406 ! 407 DO jj = 1, jpj ! take in account min depth of ocean rn_hmin 408 DO ji = 1, jpi 409 IF( zrnf(ji,jj) > 0._wp ) THEN 410 jk = mbkt(ji,jj) 411 h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) ) 412 ENDIF 413 END DO 414 END DO 415 ! 416 nk_rnf(:,:) = 0 ! number of levels on which runoffs are distributed 417 DO jj = 1, jpj 418 DO ji = 1, jpi 419 IF( zrnf(ji,jj) > 0._wp ) THEN 420 jk = 2 421 DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1 374 422 END DO 423 nk_rnf(ji,jj) = jk 424 ELSE 425 nk_rnf(ji,jj) = 1 426 ENDIF 427 END DO 428 END DO 429 ! 430 DEALLOCATE( zrnf ) 431 ! 432 DO jj = 1, jpj ! set the associated depth 433 DO ji = 1, jpi 434 h_rnf(ji,jj) = 0._wp 435 DO jk = 1, nk_rnf(ji,jj) 436 h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 375 437 END DO 376 438 END DO 377 ELSE ! runoffs applied at the surface 378 nk_rnf(:,:) = 1 379 h_rnf (:,:) = fse3t(:,:,1) 380 ENDIF 381 ! 439 END DO 440 ! 441 IF( nn_rnf_depth_file == 1 ) THEN ! save output nb levels for runoff 442 IF(lwp) WRITE(numout,*) ' create runoff depht file' 443 CALL iom_open ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE., kiolib = jprstlib ) 444 CALL iom_rstput( 0, 0, inum, 'rodepth', h_rnf ) 445 CALL iom_close ( inum ) 446 ENDIF 447 ELSE ! runoffs applied at the surface 448 nk_rnf(:,:) = 1 449 h_rnf (:,:) = fse3t(:,:,1) 382 450 ENDIF 383 451 ! … … 400 468 IF( rn_hrnf > 0._wp ) THEN 401 469 nkrnf = 2 402 DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf ) ; nkrnf = nkrnf + 1 ; END DO 470 DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf ) ; nkrnf = nkrnf + 1 471 END DO 403 472 IF( ln_sco ) CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' ) 404 473 ENDIF -
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r5307 r5449 58 58 REAL(wp) :: zcoef, zf_sbc ! local scalar 59 59 REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts 60 REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb,zdep61 60 !!--------------------------------------------------------------------- 62 63 ! !* first wet T-, U-, V- ocean level (ISF)variables (T, S, depth, velocity)61 62 ! !* surface T-, U-, V- ocean level variables (T, S, depth, velocity) 64 63 DO jj = 1, jpj 65 64 DO ji = 1, jpi 66 zub(ji,jj) = ub (ji,jj,miku(ji,jj))67 zvb(ji,jj) = vb (ji,jj,mikv(ji,jj))68 65 zts(ji,jj,jp_tem) = tsn(ji,jj,mikt(ji,jj),jp_tem) 69 66 zts(ji,jj,jp_sal) = tsn(ji,jj,mikt(ji,jj),jp_sal) … … 71 68 END DO 72 69 ! 73 IF( lk_vvl ) THEN74 DO jj = 1, jpj75 DO ji = 1, jpi76 zdep(ji,jj) = fse3t_n(ji,jj,mikt(ji,jj))77 END DO78 END DO79 ENDIF80 ! ! ---------------------------------------- !81 70 IF( nn_fsbc == 1 ) THEN ! Instantaneous surface fields ! 82 71 ! ! ---------------------------------------- ! 83 ssu_m(:,:) = zub(:,:)84 ssv_m(:,:) = zvb(:,:)72 ssu_m(:,:) = ub(:,:,1) 73 ssv_m(:,:) = vb(:,:,1) 85 74 IF( ln_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 86 75 ELSE ; sst_m(:,:) = zts(:,:,jp_tem) … … 92 81 ENDIF 93 82 ! 94 IF( lk_vvl ) fse3t_m(:,:) = zdep(:,:) 83 IF( lk_vvl ) e3t_m(:,:) = fse3t_n(:,:,1) 84 ! 85 frq_m(:,:) = fraqsr_1lev(:,:) 95 86 ! 96 87 ELSE … … 101 92 IF(lwp) WRITE(numout,*) '~~~~~~~ mean fields initialised to instantaneous values' 102 93 zcoef = REAL( nn_fsbc - 1, wp ) 103 ssu_m(:,:) = zcoef * zub(:,:)104 ssv_m(:,:) = zcoef * zvb(:,:)94 ssu_m(:,:) = zcoef * ub(:,:,1) 95 ssv_m(:,:) = zcoef * vb(:,:,1) 105 96 IF( ln_useCT ) THEN ; sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 106 97 ELSE ; sst_m(:,:) = zcoef * zts(:,:,jp_tem) … … 112 103 ENDIF 113 104 ! 114 IF( lk_vvl ) fse3t_m(:,:) = zcoef * zdep(:,:) 105 IF( lk_vvl ) e3t_m(:,:) = zcoef * fse3t_n(:,:,1) 106 ! 107 frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 115 108 ! ! ---------------------------------------- ! 116 109 ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN ! Initialisation: New mean computation ! … … 121 114 sss_m(:,:) = 0.e0 122 115 ssh_m(:,:) = 0.e0 123 IF( lk_vvl ) fse3t_m(:,:) = 0.e0 116 IF( lk_vvl ) e3t_m(:,:) = 0.e0 117 frq_m(:,:) = 0.e0 124 118 ENDIF 125 119 ! ! ---------------------------------------- ! 126 120 ! ! Cumulate at each time step ! 127 121 ! ! ---------------------------------------- ! 128 ssu_m(:,:) = ssu_m(:,:) + zub(:,:)129 ssv_m(:,:) = ssv_m(:,:) + zvb(:,:)122 ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 123 ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 130 124 IF( ln_useCT ) THEN ; sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 131 125 ELSE ; sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem) … … 137 131 ENDIF 138 132 ! 139 IF( lk_vvl ) fse3t_m(:,:) = fse3t_m(:,:) + zdep(:,:) 133 IF( lk_vvl ) e3t_m(:,:) = fse3t_m(:,:) + fse3t_n(:,:,1) 134 ! 135 frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:) 140 136 141 137 ! ! ---------------------------------------- ! … … 148 144 ssv_m(:,:) = ssv_m(:,:) * zcoef ! 149 145 ssh_m(:,:) = ssh_m(:,:) * zcoef ! mean SSH [m] 150 IF( lk_vvl ) fse3t_m(:,:) = fse3t_m(:,:) * zcoef ! mean vertical scale factor [m] 146 IF( lk_vvl ) e3t_m(:,:) = fse3t_m(:,:) * zcoef ! mean vertical scale factor [m] 147 frq_m(:,:) = frq_m(:,:) * zcoef ! mean fraction of solar net radiation absorbed in the 1st T level [-] 151 148 ! 152 149 ENDIF … … 165 162 CALL iom_rstput( kt, nitrst, numrow, 'sss_m' , sss_m ) 166 163 CALL iom_rstput( kt, nitrst, numrow, 'ssh_m' , ssh_m ) 167 IF( lk_vvl ) THEN 168 CALL iom_rstput( kt, nitrst, numrow, 'fse3t_m' , fse3t_m(:,:) ) 169 END IF 170 ! 171 ENDIF 172 ! 164 IF( lk_vvl ) CALL iom_rstput( kt, nitrst, numrow, 'e3t_m' , e3t_m ) 165 CALL iom_rstput( kt, nitrst, numrow, 'frq_m' , frq_m ) 166 ! 167 ENDIF 168 ! 169 ENDIF 170 ! 171 IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN ! Mean value at each nn_fsbc time-step ! 172 CALL iom_put( 'ssu_m', ssu_m ) 173 CALL iom_put( 'ssv_m', ssv_m ) 174 CALL iom_put( 'sst_m', sst_m ) 175 CALL iom_put( 'sss_m', sss_m ) 176 CALL iom_put( 'ssh_m', ssh_m ) 177 IF( lk_vvl ) CALL iom_put( 'e3t_m', e3t_m ) 178 CALL iom_put( 'frq_m', frq_m ) 173 179 ENDIF 174 180 ! … … 206 212 CALL iom_get( numror, jpdom_autoglo, 'sss_m' , sss_m ) ! " " salinity (T-point) 207 213 CALL iom_get( numror, jpdom_autoglo, 'ssh_m' , ssh_m ) ! " " height (T-point) 208 IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_m', fse3t_m(:,:) ) 214 IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'e3t_m', e3t_m ) 215 ! fraction of solar net radiation absorbed in 1st T level 216 IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN 217 CALL iom_get( numror, jpdom_autoglo, 'frq_m' , frq_m ) 218 ELSE 219 frq_m(:,:) = 1._wp ! default definition 220 ENDIF 209 221 ! 210 222 IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN ! nn_fsbc has changed between 2 runs … … 217 229 sss_m(:,:) = zcoef * sss_m(:,:) 218 230 ssh_m(:,:) = zcoef * ssh_m(:,:) 219 IF( lk_vvl ) fse3t_m(:,:) = zcoef * fse3t_m(:,:) 231 IF( lk_vvl ) e3t_m(:,:) = zcoef * fse3t_m(:,:) 232 frq_m(:,:) = zcoef * frq_m(:,:) 220 233 ELSE 221 234 IF(lwp) WRITE(numout,*) '~~~~~~~ mean fields read in the ocean restart file' … … 224 237 ENDIF 225 238 ! 239 IF( .NOT. l_ssm_mean ) THEN ! default initialisation. needed by lim_istate 240 ! 241 IF(lwp) WRITE(numout,*) ' default initialisation of ss?_m arrays' 242 ssu_m(:,:) = ub(:,:,1) 243 ssv_m(:,:) = vb(:,:,1) 244 IF( ln_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 245 ELSE ; sst_m(:,:) = tsn(:,:,1,jp_tem) 246 ENDIF 247 sss_m(:,:) = tsn(:,:,1,jp_sal) 248 ssh_m(:,:) = sshn(:,:) 249 IF( lk_vvl ) e3t_m(:,:) = fse3t_n(:,:,1) 250 frq_m(:,:) = 1._wp 251 ! 252 ENDIF 253 ! 226 254 END SUBROUTINE sbc_ssm_init 227 255 -
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90
- Property svn:keywords set to Id
-
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
- Property svn:keywords set to Id
-
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90
- Property svn:keywords set to Id
-
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90
- Property svn:keywords set to Id
r5307 r5449 80 80 END DO 81 81 END DO 82 ! 83 ! Ensure that tidal components have been set in namelist_cfg 84 IF( nb_harmo .EQ. 0 ) CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' ) 82 85 ! 83 86 IF(lwp) THEN -
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90
- Property svn:keywords set to Id
Note: See TracChangeset
for help on using the changeset viewer.