- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r4664 r6225 9 9 !! 3.4 ! 2011_11 (C. Harris) more flexibility + multi-category fields 10 10 !!---------------------------------------------------------------------- 11 #if defined key_oasis3 || defined key_oasis412 !!----------------------------------------------------------------------13 !! 'key_oasis3' or 'key_oasis4' Coupled Ocean/Atmosphere formulation14 11 !!---------------------------------------------------------------------- 15 12 !! namsbc_cpl : coupled formulation namlist … … 21 18 !! sbc_cpl_snd : send fields to the atmosphere 22 19 !!---------------------------------------------------------------------- 23 USE dom_oce ! ocean space and time domain 24 USE sbc_oce ! Surface boundary condition: ocean fields 25 USE sbc_ice ! Surface boundary condition: ice fields 26 USE sbcdcy ! surface boundary condition: diurnal cycle 27 USE phycst ! physical constants 20 USE dom_oce ! ocean space and time domain 21 USE sbc_oce ! Surface boundary condition: ocean fields 22 USE sbc_ice ! Surface boundary condition: ice fields 23 USE sbcapr ! Stochastic param. : ??? 24 USE sbcdcy ! surface boundary condition: diurnal cycle 25 USE phycst ! physical constants 28 26 #if defined key_lim3 29 USE par_ice ! ice parameters 30 USE ice ! ice variables 27 USE ice ! ice variables 31 28 #endif 32 29 #if defined key_lim2 33 USE par_ice_2 34 USE ice_2 30 USE par_ice_2 ! ice parameters 31 USE ice_2 ! ice variables 35 32 #endif 36 #if defined key_oasis3 37 USE cpl_oasis3 ! OASIS3 coupling 38 #endif 39 #if defined key_oasis4 40 USE cpl_oasis4 ! OASIS4 coupling 41 #endif 42 USE geo2ocean ! 43 USE oce , ONLY : tsn, un, vn 44 USE albedo ! 45 USE in_out_manager ! I/O manager 46 USE iom ! NetCDF library 47 USE lib_mpp ! distribued memory computing library 48 USE wrk_nemo ! work arrays 49 USE timing ! Timing 50 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 33 USE cpl_oasis3 ! OASIS3 coupling 34 USE geo2ocean ! 35 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 36 USE albedo ! 37 USE eosbn2 ! 38 USE sbcrnf , ONLY : l_rnfcpl 51 39 #if defined key_cpl_carbon_cycle 52 40 USE p4zflx, ONLY : oce_co2 53 41 #endif 54 USE diaar5, ONLY : lk_diaar555 42 #if defined key_cice 56 43 USE ice_domain_size, only: ncat 57 44 #endif 45 #if defined key_lim3 46 USE limthd_dh ! for CALL lim_thd_snwblow 47 #endif 48 ! 49 USE in_out_manager ! I/O manager 50 USE iom ! NetCDF library 51 USE lib_mpp ! distribued memory computing library 52 USE wrk_nemo ! work arrays 53 USE timing ! Timing 54 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 55 58 56 IMPLICIT NONE 59 57 PRIVATE 60 58 61 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90 62 PUBLIC sbc_cpl_snd ! routine called by step.F90 63 PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim(_2).F90 64 PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim(_2).F90 65 66 INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 1 67 INTEGER, PARAMETER :: jpr_oty1 = 2 ! 68 INTEGER, PARAMETER :: jpr_otz1 = 3 ! 69 INTEGER, PARAMETER :: jpr_otx2 = 4 ! 3 atmosphere-ocean stress components on grid 2 70 INTEGER, PARAMETER :: jpr_oty2 = 5 ! 71 INTEGER, PARAMETER :: jpr_otz2 = 6 ! 72 INTEGER, PARAMETER :: jpr_itx1 = 7 ! 3 atmosphere-ice stress components on grid 1 73 INTEGER, PARAMETER :: jpr_ity1 = 8 ! 74 INTEGER, PARAMETER :: jpr_itz1 = 9 ! 75 INTEGER, PARAMETER :: jpr_itx2 = 10 ! 3 atmosphere-ice stress components on grid 2 76 INTEGER, PARAMETER :: jpr_ity2 = 11 ! 77 INTEGER, PARAMETER :: jpr_itz2 = 12 ! 78 INTEGER, PARAMETER :: jpr_qsroce = 13 ! Qsr above the ocean 79 INTEGER, PARAMETER :: jpr_qsrice = 14 ! Qsr above the ice 59 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 60 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90 61 PUBLIC sbc_cpl_snd ! routine called by step.F90 62 PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim(_2).F90 63 PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim(_2).F90 64 PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90 65 66 INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 1 67 INTEGER, PARAMETER :: jpr_oty1 = 2 ! 68 INTEGER, PARAMETER :: jpr_otz1 = 3 ! 69 INTEGER, PARAMETER :: jpr_otx2 = 4 ! 3 atmosphere-ocean stress components on grid 2 70 INTEGER, PARAMETER :: jpr_oty2 = 5 ! 71 INTEGER, PARAMETER :: jpr_otz2 = 6 ! 72 INTEGER, PARAMETER :: jpr_itx1 = 7 ! 3 atmosphere-ice stress components on grid 1 73 INTEGER, PARAMETER :: jpr_ity1 = 8 ! 74 INTEGER, PARAMETER :: jpr_itz1 = 9 ! 75 INTEGER, PARAMETER :: jpr_itx2 = 10 ! 3 atmosphere-ice stress components on grid 2 76 INTEGER, PARAMETER :: jpr_ity2 = 11 ! 77 INTEGER, PARAMETER :: jpr_itz2 = 12 ! 78 INTEGER, PARAMETER :: jpr_qsroce = 13 ! Qsr above the ocean 79 INTEGER, PARAMETER :: jpr_qsrice = 14 ! Qsr above the ice 80 80 INTEGER, PARAMETER :: jpr_qsrmix = 15 81 INTEGER, PARAMETER :: jpr_qnsoce = 16 82 INTEGER, PARAMETER :: jpr_qnsice = 17 81 INTEGER, PARAMETER :: jpr_qnsoce = 16 ! Qns above the ocean 82 INTEGER, PARAMETER :: jpr_qnsice = 17 ! Qns above the ice 83 83 INTEGER, PARAMETER :: jpr_qnsmix = 18 84 INTEGER, PARAMETER :: jpr_rain = 19 85 INTEGER, PARAMETER :: jpr_snow = 20 86 INTEGER, PARAMETER :: jpr_tevp = 21 87 INTEGER, PARAMETER :: jpr_ievp = 22 88 INTEGER, PARAMETER :: jpr_sbpr = 23 89 INTEGER, PARAMETER :: jpr_semp = 24 90 INTEGER, PARAMETER :: jpr_oemp = 25 91 INTEGER, PARAMETER :: jpr_w10m = 26 92 INTEGER, PARAMETER :: jpr_dqnsdt = 27 93 INTEGER, PARAMETER :: jpr_rnf = 28 94 INTEGER, PARAMETER :: jpr_cal = 29 95 INTEGER, PARAMETER :: jpr_taum = 30 84 INTEGER, PARAMETER :: jpr_rain = 19 ! total liquid precipitation (rain) 85 INTEGER, PARAMETER :: jpr_snow = 20 ! solid precipitation over the ocean (snow) 86 INTEGER, PARAMETER :: jpr_tevp = 21 ! total evaporation 87 INTEGER, PARAMETER :: jpr_ievp = 22 ! solid evaporation (sublimation) 88 INTEGER, PARAMETER :: jpr_sbpr = 23 ! sublimation - liquid precipitation - solid precipitation 89 INTEGER, PARAMETER :: jpr_semp = 24 ! solid freshwater budget (sublimation - snow) 90 INTEGER, PARAMETER :: jpr_oemp = 25 ! ocean freshwater budget (evap - precip) 91 INTEGER, PARAMETER :: jpr_w10m = 26 ! 10m wind 92 INTEGER, PARAMETER :: jpr_dqnsdt = 27 ! d(Q non solar)/d(temperature) 93 INTEGER, PARAMETER :: jpr_rnf = 28 ! runoffs 94 INTEGER, PARAMETER :: jpr_cal = 29 ! calving 95 INTEGER, PARAMETER :: jpr_taum = 30 ! wind stress module 96 96 INTEGER, PARAMETER :: jpr_co2 = 31 97 INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn 98 INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn 99 INTEGER, PARAMETER :: jprcv = 33 ! total number of fields received 100 101 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction 102 INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature 103 INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature 104 INTEGER, PARAMETER :: jps_tmix = 4 ! mixed temperature (ocean+ice) 105 INTEGER, PARAMETER :: jps_albice = 5 ! ice albedo 106 INTEGER, PARAMETER :: jps_albmix = 6 ! mixed albedo 107 INTEGER, PARAMETER :: jps_hice = 7 ! ice thickness 108 INTEGER, PARAMETER :: jps_hsnw = 8 ! snow thickness 109 INTEGER, PARAMETER :: jps_ocx1 = 9 ! ocean current on grid 1 110 INTEGER, PARAMETER :: jps_ocy1 = 10 ! 111 INTEGER, PARAMETER :: jps_ocz1 = 11 ! 112 INTEGER, PARAMETER :: jps_ivx1 = 12 ! ice current on grid 1 113 INTEGER, PARAMETER :: jps_ivy1 = 13 ! 114 INTEGER, PARAMETER :: jps_ivz1 = 14 ! 97 INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn 98 INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn 99 INTEGER, PARAMETER :: jpr_sflx = 34 ! salt flux 100 INTEGER, PARAMETER :: jpr_toce = 35 ! ocean temperature 101 INTEGER, PARAMETER :: jpr_soce = 36 ! ocean salinity 102 INTEGER, PARAMETER :: jpr_ocx1 = 37 ! ocean current on grid 1 103 INTEGER, PARAMETER :: jpr_ocy1 = 38 ! 104 INTEGER, PARAMETER :: jpr_ssh = 39 ! sea surface height 105 INTEGER, PARAMETER :: jpr_fice = 40 ! ice fraction 106 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 107 INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level 108 INTEGER, PARAMETER :: jprcv = 42 ! total number of fields received 109 110 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere 111 INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature 112 INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature 113 INTEGER, PARAMETER :: jps_tmix = 4 ! mixed temperature (ocean+ice) 114 INTEGER, PARAMETER :: jps_albice = 5 ! ice albedo 115 INTEGER, PARAMETER :: jps_albmix = 6 ! mixed albedo 116 INTEGER, PARAMETER :: jps_hice = 7 ! ice thickness 117 INTEGER, PARAMETER :: jps_hsnw = 8 ! snow thickness 118 INTEGER, PARAMETER :: jps_ocx1 = 9 ! ocean current on grid 1 119 INTEGER, PARAMETER :: jps_ocy1 = 10 ! 120 INTEGER, PARAMETER :: jps_ocz1 = 11 ! 121 INTEGER, PARAMETER :: jps_ivx1 = 12 ! ice current on grid 1 122 INTEGER, PARAMETER :: jps_ivy1 = 13 ! 123 INTEGER, PARAMETER :: jps_ivz1 = 14 ! 115 124 INTEGER, PARAMETER :: jps_co2 = 15 116 INTEGER, PARAMETER :: jpsnd = 15 ! total number of fields sended 117 118 ! !!** namelist namsbc_cpl ** 119 TYPE :: FLD_C 120 CHARACTER(len = 32) :: cldes ! desciption of the coupling strategy 121 CHARACTER(len = 32) :: clcat ! multiple ice categories strategy 122 CHARACTER(len = 32) :: clvref ! reference of vector ('spherical' or 'cartesian') 123 CHARACTER(len = 32) :: clvor ! orientation of vector fields ('eastward-northward' or 'local grid') 124 CHARACTER(len = 32) :: clvgrd ! grids on which is located the vector fields 125 INTEGER, PARAMETER :: jps_soce = 16 ! ocean salinity 126 INTEGER, PARAMETER :: jps_ssh = 17 ! sea surface height 127 INTEGER, PARAMETER :: jps_qsroce = 18 ! Qsr above the ocean 128 INTEGER, PARAMETER :: jps_qnsoce = 19 ! Qns above the ocean 129 INTEGER, PARAMETER :: jps_oemp = 20 ! ocean freshwater budget (evap - precip) 130 INTEGER, PARAMETER :: jps_sflx = 21 ! salt flux 131 INTEGER, PARAMETER :: jps_otx1 = 22 ! 2 atmosphere-ocean stress components on grid 1 132 INTEGER, PARAMETER :: jps_oty1 = 23 ! 133 INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs 134 INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module 135 INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling) 136 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 137 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level 138 INTEGER, PARAMETER :: jpsnd = 28 ! total number of fields sended 139 140 ! !!** namelist namsbc_cpl ** 141 TYPE :: FLD_C ! 142 CHARACTER(len = 32) :: cldes ! desciption of the coupling strategy 143 CHARACTER(len = 32) :: clcat ! multiple ice categories strategy 144 CHARACTER(len = 32) :: clvref ! reference of vector ('spherical' or 'cartesian') 145 CHARACTER(len = 32) :: clvor ! orientation of vector fields ('eastward-northward' or 'local grid') 146 CHARACTER(len = 32) :: clvgrd ! grids on which is located the vector fields 125 147 END TYPE FLD_C 126 ! Send to the atmosphere !148 ! ! Send to the atmosphere 127 149 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 128 ! Received from the atmosphere !150 ! ! Received from the atmosphere 129 151 TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 130 152 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 131 153 ! ! Other namelist parameters 154 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 155 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 156 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 132 157 TYPE :: DYNARR 133 158 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 134 159 END TYPE DYNARR 135 160 136 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere 137 138 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 139 140 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument 141 142 #if ! defined key_lim2 && ! defined key_lim3 143 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 144 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice, alb_ice, qns_ice, dqns_ice ! (jpi,jpj,jpl) 145 #endif 146 147 #if defined key_cice 148 INTEGER, PARAMETER :: jpl = ncat 149 #elif ! defined key_lim2 && ! defined key_lim3 150 INTEGER, PARAMETER :: jpl = 1 151 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice 152 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice 153 #endif 154 155 #if ! defined key_lim3 && ! defined key_cice 156 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i 157 #endif 158 159 #if ! defined key_lim3 160 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i, ht_s 161 #endif 162 163 #if ! defined key_cice 164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt, botmelt 165 #endif 161 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere 162 163 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 164 165 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument 166 166 167 167 !! Substitution 168 168 # include "vectopt_loop_substitute.h90" 169 169 !!---------------------------------------------------------------------- 170 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)170 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 171 171 !! $Id$ 172 172 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 173 173 !!---------------------------------------------------------------------- 174 175 174 CONTAINS 176 175 … … 179 178 !! *** FUNCTION sbc_cpl_alloc *** 180 179 !!---------------------------------------------------------------------- 181 INTEGER :: ierr( 4),jn180 INTEGER :: ierr(3) 182 181 !!---------------------------------------------------------------------- 183 182 ierr(:) = 0 184 183 ! 185 184 ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) ) 186 ! 187 #if ! defined key_lim2 && ! defined key_lim3 188 ! quick patch to be able to run the coupled model without sea-ice... 189 ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , & 190 v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1), & 191 emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , STAT=ierr(2) ) 185 186 #if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice 187 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 192 188 #endif 193 194 #if ! defined key_lim3 && ! defined key_cice 195 ALLOCATE( a_i(jpi,jpj,jpl) , STAT=ierr(3) ) 196 #endif 197 198 #if defined key_cice || defined key_lim2 199 ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(4) ) 200 #endif 189 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 190 ! 201 191 sbc_cpl_alloc = MAXVAL( ierr ) 202 192 IF( lk_mpp ) CALL mpp_sum ( sbc_cpl_alloc ) … … 210 200 !! *** ROUTINE sbc_cpl_init *** 211 201 !! 212 !! ** Purpose : Initialisation of send and rec ieved information from202 !! ** Purpose : Initialisation of send and received information from 213 203 !! the atmospheric component 214 204 !! … … 218 208 !! * initialise the OASIS coupler 219 209 !!---------------------------------------------------------------------- 220 INTEGER, INTENT(in) :: k_ice 221 ! !222 INTEGER :: jn ! dummy loop index223 INTEGER :: ios ! Local integer output status for namelist read210 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 211 ! 212 INTEGER :: jn ! dummy loop index 213 INTEGER :: ios, inum ! Local integer 224 214 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 225 215 !! 226 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 227 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 228 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx , sn_rcv_co2 216 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 217 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 218 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, & 219 & sn_rcv_co2 , nn_cplmodel , ln_usecplmask 229 220 !!--------------------------------------------------------------------- 230 221 ! 231 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init')232 ! 233 CALL wrk_alloc( jpi,jpj, zacs, zaos )222 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init') 223 ! 224 CALL wrk_alloc( jpi,jpj, zacs, zaos ) 234 225 235 226 ! ================================ ! 236 227 ! Namelist informations ! 237 228 ! ================================ ! 238 229 ! 239 230 REWIND( numnam_ref ) ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling 240 231 READ ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901) 241 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp )242 232 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp ) 233 ! 243 234 REWIND( numnam_cfg ) ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling 244 235 READ ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 ) 245 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp )236 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp ) 246 237 IF(lwm) WRITE ( numond, namsbc_cpl ) 247 238 ! 248 239 IF(lwp) THEN ! control print 249 240 WRITE(numout,*) 250 241 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 251 242 WRITE(numout,*)'~~~~~~~~~~~~' 243 ENDIF 244 IF( lwp .AND. ln_cpl ) THEN ! control print 252 245 WRITE(numout,*)' received fields (mutiple ice categogies)' 253 246 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' … … 274 267 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 275 268 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 269 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 270 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 276 271 ENDIF 277 272 … … 377 372 srcv(jpr_ity1)%clgrid = 'V' ! i.e. it is always at U- & V-points for i- & j-comp. resp. 378 373 ENDIF 379 374 ! 380 375 ! ! ------------------------- ! 381 376 ! ! freshwater budget ! E-P … … 391 386 srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip 392 387 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 388 CASE( 'none' ) ! nothing to do 393 389 CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE. 394 390 CASE( 'conservative' ) … … 398 394 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 399 395 END SELECT 400 396 ! 401 397 ! ! ------------------------- ! 402 398 ! ! Runoffs & Calving ! 403 399 ! ! ------------------------- ! 404 srcv(jpr_rnf )%clname = 'O_Runoff' ; IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 405 ! This isn't right - really just want ln_rnf_emp changed 406 ! IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' ) THEN ; ln_rnf = .TRUE. 407 ! ELSE ; ln_rnf = .FALSE. 408 ! ENDIF 400 srcv(jpr_rnf )%clname = 'O_Runoff' 401 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 402 srcv(jpr_rnf)%laction = .TRUE. 403 l_rnfcpl = .TRUE. ! -> no need to read runoffs in sbcrnf 404 ln_rnf = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas 405 IF(lwp) WRITE(numout,*) 406 IF(lwp) WRITE(numout,*) ' runoffs received from oasis -> force ln_rnf = ', ln_rnf 407 ENDIF 408 ! 409 409 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 410 410 ! 411 411 ! ! ------------------------- ! 412 412 ! ! non solar radiation ! Qns … … 416 416 srcv(jpr_qnsmix)%clname = 'O_QnsMix' 417 417 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 418 CASE( 'none' ) ! nothing to do 418 419 CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE. 419 420 CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. … … 431 432 srcv(jpr_qsrmix)%clname = 'O_QsrMix' 432 433 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 434 CASE( 'none' ) ! nothing to do 433 435 CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE. 434 436 CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. … … 446 448 ! 447 449 ! non solar sensitivity mandatory for LIM ice model 448 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 ) &450 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) & 449 451 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 450 452 ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique … … 479 481 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 480 482 ENDIF 481 482 ! Allocate all parts of frcv used for received fields 483 ! ! ------------------------------- ! 484 ! ! OPA-SAS coupling - rcv by opa ! 485 ! ! ------------------------------- ! 486 srcv(jpr_sflx)%clname = 'O_SFLX' 487 srcv(jpr_fice)%clname = 'RIceFrc' 488 ! 489 IF( nn_components == jp_iam_opa ) THEN ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS) 490 srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 491 srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling 492 srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling 493 srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE. 494 srcv(jpr_otx1)%clgrid = 'U' ! oce components given at U-point 495 srcv(jpr_oty1)%clgrid = 'V' ! and V-point 496 ! Vectors: change of sign at north fold ONLY if on the local grid 497 srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1. 498 sn_rcv_tau%clvgrd = 'U,V' 499 sn_rcv_tau%clvor = 'local grid' 500 sn_rcv_tau%clvref = 'spherical' 501 sn_rcv_emp%cldes = 'oce only' 502 ! 503 IF(lwp) THEN ! control print 504 WRITE(numout,*) 505 WRITE(numout,*)' Special conditions for SAS-OPA coupling ' 506 WRITE(numout,*)' OPA component ' 507 WRITE(numout,*) 508 WRITE(numout,*)' received fields from SAS component ' 509 WRITE(numout,*)' ice cover ' 510 WRITE(numout,*)' oce only EMP ' 511 WRITE(numout,*)' salt flux ' 512 WRITE(numout,*)' mixed oce-ice solar flux ' 513 WRITE(numout,*)' mixed oce-ice non solar flux ' 514 WRITE(numout,*)' wind stress U,V on local grid and sperical coordinates ' 515 WRITE(numout,*)' wind stress module' 516 WRITE(numout,*) 517 ENDIF 518 ENDIF 519 ! ! -------------------------------- ! 520 ! ! OPA-SAS coupling - rcv by sas ! 521 ! ! -------------------------------- ! 522 srcv(jpr_toce )%clname = 'I_SSTSST' 523 srcv(jpr_soce )%clname = 'I_SSSal' 524 srcv(jpr_ocx1 )%clname = 'I_OCurx1' 525 srcv(jpr_ocy1 )%clname = 'I_OCury1' 526 srcv(jpr_ssh )%clname = 'I_SSHght' 527 srcv(jpr_e3t1st)%clname = 'I_E3T1st' 528 srcv(jpr_fraqsr)%clname = 'I_FraQsr' 529 ! 530 IF( nn_components == jp_iam_sas ) THEN 531 IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 532 IF( .NOT. ln_cpl ) srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling 533 IF( .NOT. ln_cpl ) srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling 534 srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE. 535 srcv( jpr_e3t1st )%laction = .NOT.ln_linssh 536 srcv(jpr_ocx1)%clgrid = 'U' ! oce components given at U-point 537 srcv(jpr_ocy1)%clgrid = 'V' ! and V-point 538 ! Vectors: change of sign at north fold ONLY if on the local grid 539 srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1. 540 ! Change first letter to couple with atmosphere if already coupled OPA 541 ! this is nedeed as each variable name used in the namcouple must be unique: 542 ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere 543 DO jn = 1, jprcv 544 IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 545 END DO 546 ! 547 IF(lwp) THEN ! control print 548 WRITE(numout,*) 549 WRITE(numout,*)' Special conditions for SAS-OPA coupling ' 550 WRITE(numout,*)' SAS component ' 551 WRITE(numout,*) 552 IF( .NOT. ln_cpl ) THEN 553 WRITE(numout,*)' received fields from OPA component ' 554 ELSE 555 WRITE(numout,*)' Additional received fields from OPA component : ' 556 ENDIF 557 WRITE(numout,*)' sea surface temperature (Celcius) ' 558 WRITE(numout,*)' sea surface salinity ' 559 WRITE(numout,*)' surface currents ' 560 WRITE(numout,*)' sea surface height ' 561 WRITE(numout,*)' thickness of first ocean T level ' 562 WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level' 563 WRITE(numout,*) 564 ENDIF 565 ENDIF 566 567 ! =================================================== ! 568 ! Allocate all parts of frcv used for received fields ! 569 ! =================================================== ! 483 570 DO jn = 1, jprcv 484 571 IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 485 572 END DO 486 573 ! Allocate taum part of frcv which is used even when not received as coupling field 487 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jn)%nct) ) 574 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 575 ! Allocate w10m part of frcv which is used even when not received as coupling field 576 IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 577 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 578 IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 579 IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 488 580 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 489 581 IF( k_ice /= 0 ) THEN 490 IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(j n)%nct) )491 IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(j n)%nct) )582 IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 583 IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 492 584 END IF 493 585 … … 509 601 ssnd(jps_tmix)%clname = 'O_TepMix' 510 602 SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 511 CASE( 'none' ) ! nothing to do512 CASE( 'oce only' ) ; ssnd( jps_toce)%laction = .TRUE.513 CASE( ' weighted oce and ice' )603 CASE( 'none' ) ! nothing to do 604 CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE. 605 CASE( 'oce and ice' , 'weighted oce and ice' ) 514 606 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 515 607 IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl 516 CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix)%laction = .TRUE.608 CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE. 517 609 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 518 610 END SELECT 519 611 520 612 ! ! ------------------------- ! 521 613 ! ! Albedo ! … … 524 616 ssnd(jps_albmix)%clname = 'O_AlbMix' 525 617 SELECT CASE( TRIM( sn_snd_alb%cldes ) ) 526 CASE( 'none' )! nothing to do527 CASE( ' weighted ice' ) ;ssnd(jps_albice)%laction = .TRUE.528 CASE( 'mixed oce-ice' ) ;ssnd(jps_albmix)%laction = .TRUE.618 CASE( 'none' ) ! nothing to do 619 CASE( 'ice' , 'weighted ice' ) ; ssnd(jps_albice)%laction = .TRUE. 620 CASE( 'mixed oce-ice' ) ; ssnd(jps_albmix)%laction = .TRUE. 529 621 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' ) 530 622 END SELECT … … 550 642 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 551 643 ENDIF 552 644 553 645 SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 554 646 CASE( 'none' ) ! nothing to do … … 557 649 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 558 650 ssnd(jps_hice:jps_hsnw)%nct = jpl 559 ELSE560 IF ( jpl > 1 ) THEN561 CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' )562 ENDIF563 651 ENDIF 564 652 CASE ( 'weighted ice and snow' ) … … 599 687 ! ! ------------------------- ! 600 688 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 689 690 ! ! ------------------------------- ! 691 ! ! OPA-SAS coupling - snd by opa ! 692 ! ! ------------------------------- ! 693 ssnd(jps_ssh )%clname = 'O_SSHght' 694 ssnd(jps_soce )%clname = 'O_SSSal' 695 ssnd(jps_e3t1st)%clname = 'O_E3T1st' 696 ssnd(jps_fraqsr)%clname = 'O_FraQsr' 697 ! 698 IF( nn_components == jp_iam_opa ) THEN 699 ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 700 ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE. 701 ssnd( jps_e3t1st )%laction = .NOT.ln_linssh 702 ! vector definition: not used but cleaner... 703 ssnd(jps_ocx1)%clgrid = 'U' ! oce components given at U-point 704 ssnd(jps_ocy1)%clgrid = 'V' ! and V-point 705 sn_snd_crt%clvgrd = 'U,V' 706 sn_snd_crt%clvor = 'local grid' 707 sn_snd_crt%clvref = 'spherical' 708 ! 709 IF(lwp) THEN ! control print 710 WRITE(numout,*) 711 WRITE(numout,*)' sent fields to SAS component ' 712 WRITE(numout,*)' sea surface temperature (T before, Celcius) ' 713 WRITE(numout,*)' sea surface salinity ' 714 WRITE(numout,*)' surface currents U,V on local grid and spherical coordinates' 715 WRITE(numout,*)' sea surface height ' 716 WRITE(numout,*)' thickness of first ocean T level ' 717 WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level' 718 WRITE(numout,*) 719 ENDIF 720 ENDIF 721 ! ! ------------------------------- ! 722 ! ! OPA-SAS coupling - snd by sas ! 723 ! ! ------------------------------- ! 724 ssnd(jps_sflx )%clname = 'I_SFLX' 725 ssnd(jps_fice2 )%clname = 'IIceFrc' 726 ssnd(jps_qsroce)%clname = 'I_QsrOce' 727 ssnd(jps_qnsoce)%clname = 'I_QnsOce' 728 ssnd(jps_oemp )%clname = 'IOEvaMPr' 729 ssnd(jps_otx1 )%clname = 'I_OTaux1' 730 ssnd(jps_oty1 )%clname = 'I_OTauy1' 731 ssnd(jps_rnf )%clname = 'I_Runoff' 732 ssnd(jps_taum )%clname = 'I_TauMod' 733 ! 734 IF( nn_components == jp_iam_sas ) THEN 735 IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 736 ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE. 737 ! 738 ! Change first letter to couple with atmosphere if already coupled with sea_ice 739 ! this is nedeed as each variable name used in the namcouple must be unique: 740 ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 741 DO jn = 1, jpsnd 742 IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 743 END DO 744 ! 745 IF(lwp) THEN ! control print 746 WRITE(numout,*) 747 IF( .NOT. ln_cpl ) THEN 748 WRITE(numout,*)' sent fields to OPA component ' 749 ELSE 750 WRITE(numout,*)' Additional sent fields to OPA component : ' 751 ENDIF 752 WRITE(numout,*)' ice cover ' 753 WRITE(numout,*)' oce only EMP ' 754 WRITE(numout,*)' salt flux ' 755 WRITE(numout,*)' mixed oce-ice solar flux ' 756 WRITE(numout,*)' mixed oce-ice non solar flux ' 757 WRITE(numout,*)' wind stress U,V components' 758 WRITE(numout,*)' wind stress module' 759 ENDIF 760 ENDIF 761 601 762 ! 602 763 ! ================================ ! … … 604 765 ! ================================ ! 605 766 606 CALL cpl_prism_define(jprcv, jpsnd) 607 ! 608 IF( ln_dm2dc .AND. ( cpl_prism_freq( jpr_qsroce ) + cpl_prism_freq( jpr_qsrmix ) /= 86400 ) ) & 767 CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 768 769 IF (ln_usecplmask) THEN 770 xcplmask(:,:,:) = 0. 771 CALL iom_open( 'cplmask', inum ) 772 CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel), & 773 & kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) ) 774 CALL iom_close( inum ) 775 ELSE 776 xcplmask(:,:,:) = 1. 777 ENDIF 778 xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 779 ! 780 ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' ) 781 IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 ) & 609 782 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 610 611 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 612 ! 613 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_init') 783 ncpl_qsr_freq = 86400 / ncpl_qsr_freq 784 785 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 786 ! 787 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_init') 614 788 ! 615 789 END SUBROUTINE sbc_cpl_init … … 654 828 !! 655 829 !! ** Action : update utau, vtau ocean stress at U,V grid 656 !! taum, wndm wind stres and wind speed module at T-point 830 !! taum wind stress module at T-point 831 !! wndm wind speed module at T-point over free ocean or leads in presence of sea-ice 657 832 !! qns non solar heat fluxes including emp heat content (ocean only case) 658 833 !! and the latent heat flux of solid precip. melting … … 663 838 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 664 839 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 665 !! 666 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 840 841 !! 842 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 667 843 INTEGER :: ji, jj, jn ! dummy loop indices 668 INTEGER :: isec ! number of seconds since nit000 (assuming rdt tradid not change since nit000)844 INTEGER :: isec ! number of seconds since nit000 (assuming rdt did not change since nit000) 669 845 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 670 846 REAL(wp) :: zcoef ! temporary scalar … … 672 848 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 673 849 REAL(wp) :: zzx, zzy ! temporary variables 674 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty 850 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr 675 851 !!---------------------------------------------------------------------- 676 852 ! 677 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 678 ! 679 CALL wrk_alloc( jpi,jpj, ztx, zty ) 680 681 IF( kt == nit000 ) CALL sbc_cpl_init( k_ice ) ! initialisation 682 683 ! ! Receive all the atmos. fields (including ice information) 684 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 685 DO jn = 1, jprcv ! received fields sent by the atmosphere 686 IF( srcv(jn)%laction ) CALL cpl_prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) ) 853 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 854 ! 855 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 856 ! 857 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 858 ! 859 ! ! ======================================================= ! 860 ! ! Receive all the atmos. fields (including ice information) 861 ! ! ======================================================= ! 862 isec = ( kt - nit000 ) * NINT( rdt ) ! date of exchanges 863 DO jn = 1, jprcv ! received fields sent by the atmosphere 864 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 687 865 END DO 688 866 … … 744 922 ! 745 923 ENDIF 746 747 924 ! ! ========================= ! 748 925 ! ! wind stress module ! (taum) … … 752 929 ! => need to be done only when otx1 was changed 753 930 IF( llnewtx ) THEN 754 !CDIR NOVERRCHK755 931 DO jj = 2, jpjm1 756 !CDIR NOVERRCHK757 932 DO ji = fs_2, fs_jpim1 ! vect. opt. 758 933 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) … … 773 948 ENDIF 774 949 ENDIF 775 950 ! 776 951 ! ! ========================= ! 777 952 ! ! 10 m wind speed ! (wndm) … … 782 957 IF( llnewtau ) THEN 783 958 zcoef = 1. / ( zrhoa * zcdrag ) 784 !CDIR NOVERRCHK785 959 DO jj = 1, jpj 786 !CDIR NOVERRCHK787 960 DO ji = 1, jpi 788 wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )961 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 789 962 END DO 790 963 END DO 791 964 ENDIF 792 ELSE793 IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)794 965 ENDIF 795 966 … … 798 969 IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 799 970 ! 800 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 801 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 802 taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 971 IF( ln_mixcpl ) THEN 972 utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:) 973 vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:) 974 taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:) 975 wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:) 976 ELSE 977 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 978 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 979 taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 980 wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 981 ENDIF 803 982 CALL iom_put( "taum_oce", taum ) ! output wind stress module 804 983 ! … … 806 985 807 986 #if defined key_cpl_carbon_cycle 808 ! ! atmosph. CO2 (ppm) 987 ! ! ================== ! 988 ! ! atmosph. CO2 (ppm) ! 989 ! ! ================== ! 809 990 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 810 991 #endif 811 992 993 ! Fields received by SAS when OASIS coupling 994 ! (arrays no more filled at sbcssm stage) 995 ! ! ================== ! 996 ! ! SSS ! 997 ! ! ================== ! 998 IF( srcv(jpr_soce)%laction ) THEN ! received by sas in case of opa <-> sas coupling 999 sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1) 1000 CALL iom_put( 'sss_m', sss_m ) 1001 ENDIF 1002 ! 1003 ! ! ================== ! 1004 ! ! SST ! 1005 ! ! ================== ! 1006 IF( srcv(jpr_toce)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1007 sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1) 1008 IF( srcv(jpr_soce)%laction .AND. ln_useCT ) THEN ! make sure that sst_m is the potential temperature 1009 sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) ) 1010 ENDIF 1011 ENDIF 1012 ! ! ================== ! 1013 ! ! SSH ! 1014 ! ! ================== ! 1015 IF( srcv(jpr_ssh )%laction ) THEN ! received by sas in case of opa <-> sas coupling 1016 ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1) 1017 CALL iom_put( 'ssh_m', ssh_m ) 1018 ENDIF 1019 ! ! ================== ! 1020 ! ! surface currents ! 1021 ! ! ================== ! 1022 IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1023 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1024 ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1025 un (:,:,1) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1026 CALL iom_put( 'ssu_m', ssu_m ) 1027 ENDIF 1028 IF( srcv(jpr_ocy1)%laction ) THEN 1029 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1030 vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1031 vn (:,:,1) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1032 CALL iom_put( 'ssv_m', ssv_m ) 1033 ENDIF 1034 ! ! ======================== ! 1035 ! ! first T level thickness ! 1036 ! ! ======================== ! 1037 IF( srcv(jpr_e3t1st )%laction ) THEN ! received by sas in case of opa <-> sas coupling 1038 e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1) 1039 CALL iom_put( 'e3t_m', e3t_m(:,:) ) 1040 ENDIF 1041 ! ! ================================ ! 1042 ! ! fraction of solar net radiation ! 1043 ! ! ================================ ! 1044 IF( srcv(jpr_fraqsr)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1045 frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1) 1046 CALL iom_put( 'frq_m', frq_m ) 1047 ENDIF 1048 812 1049 ! ! ========================= ! 813 IF( k_ice <= 1 ) THEN! heat & freshwater fluxes ! (Ocean only case)1050 IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN ! heat & freshwater fluxes ! (Ocean only case) 814 1051 ! ! ========================= ! 815 1052 ! 816 1053 ! ! total freshwater fluxes over the ocean (emp) 817 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 818 CASE( 'conservative' ) 819 emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 820 CASE( 'oce only', 'oce and ice' ) 821 emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 822 CASE default 823 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 824 END SELECT 1054 IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN 1055 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 1056 CASE( 'conservative' ) 1057 zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 1058 CASE( 'oce only', 'oce and ice' ) 1059 zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 1060 CASE default 1061 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 1062 END SELECT 1063 ELSE 1064 zemp(:,:) = 0._wp 1065 ENDIF 825 1066 ! 826 1067 ! ! runoffs and calving (added in emp) 827 IF( srcv(jpr_rnf)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 828 IF( srcv(jpr_cal)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 829 ! 830 !!gm : this seems to be internal cooking, not sure to need that in a generic interface 831 !!gm at least should be optional... 832 !! IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN ! add to the total freshwater budget 833 !! ! remove negative runoff 834 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 835 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 836 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) ! sum over the global domain 837 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 838 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 839 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 840 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 841 !! ENDIF 842 !! ! add runoff to e-p 843 !! emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 844 !! ENDIF 845 !!gm end of internal cooking 1068 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1069 IF( srcv(jpr_cal)%laction ) zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 1070 1071 IF( ln_mixcpl ) THEN ; emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 1072 ELSE ; emp(:,:) = zemp(:,:) 1073 ENDIF 846 1074 ! 847 1075 ! ! non solar heat flux over the ocean (qns) 848 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 849 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 850 ! add the latent heat of solid precip. melting 851 IF( srcv(jpr_snow )%laction ) THEN ! update qns over the free ocean with: 852 qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus & ! energy for melting solid precipitation over the free ocean 853 & - emp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 1076 IF( srcv(jpr_qnsoce)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1077 ELSE IF( srcv(jpr_qnsmix)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1078 ELSE ; zqns(:,:) = 0._wp 1079 END IF 1080 ! update qns over the free ocean with: 1081 IF( nn_components /= jp_iam_opa ) THEN 1082 zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 1083 IF( srcv(jpr_snow )%laction ) THEN 1084 zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean 1085 ENDIF 1086 ENDIF 1087 IF( ln_mixcpl ) THEN ; qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) 1088 ELSE ; qns(:,:) = zqns(:,:) 854 1089 ENDIF 855 1090 856 1091 ! ! solar flux over the ocean (qsr) 857 IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 858 IF( srcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 859 IF( ln_dm2dc ) qsr(:,:) = sbc_dcy( qsr ) ! modify qsr to include the diurnal cycle 1092 IF ( srcv(jpr_qsroce)%laction ) THEN ; zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 1093 ELSE IF( srcv(jpr_qsrmix)%laction ) then ; zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 1094 ELSE ; zqsr(:,:) = 0._wp 1095 ENDIF 1096 IF( ln_dm2dc .AND. ln_cpl ) zqsr(:,:) = sbc_dcy( zqsr ) ! modify qsr to include the diurnal cycle 1097 IF( ln_mixcpl ) THEN ; qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:) 1098 ELSE ; qsr(:,:) = zqsr(:,:) 1099 ENDIF 860 1100 ! 861 862 ENDIF 863 ! 864 CALL wrk_dealloc( jpi,jpj, ztx, zty ) 865 ! 866 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') 1101 ! salt flux over the ocean (received by opa in case of opa <-> sas coupling) 1102 IF( srcv(jpr_sflx )%laction ) sfx(:,:) = frcv(jpr_sflx )%z3(:,:,1) 1103 ! Ice cover (received by opa in case of opa <-> sas coupling) 1104 IF( srcv(jpr_fice )%laction ) fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 1105 ! 1106 ENDIF 1107 ! 1108 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 1109 ! 1110 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') 867 1111 ! 868 1112 END SUBROUTINE sbc_cpl_rcv … … 905 1149 REAL(wp), INTENT(out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) 906 1150 !! 907 INTEGER :: ji, jj 908 INTEGER :: itx 1151 INTEGER :: ji, jj ! dummy loop indices 1152 INTEGER :: itx ! index of taux over ice 909 1153 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty 910 1154 !!---------------------------------------------------------------------- 911 1155 ! 912 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_tau') 913 ! 914 CALL wrk_alloc( jpi,jpj, ztx, zty ) 915 916 !AC Pour eviter un stress nul sur la glace dans le cas mixed oce-ice 917 IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN ; itx = jpr_itx1 1156 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_tau') 1157 ! 1158 CALL wrk_alloc( jpi,jpj, ztx, zty ) 1159 1160 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 918 1161 ELSE ; itx = jpr_otx1 919 1162 ENDIF … … 921 1164 ! do something only if we just received the stress from atmosphere 922 1165 IF( nrcvinfo(itx) == OASIS_Rcv ) THEN 923 924 ! ! ======================= ! 925 !AC Pour eviter un stress nul sur la glace dans le cas mixes oce-ice 926 IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN ! ice stress received ! 927 ! ! ======================= ! 1166 ! ! ======================= ! 1167 IF( srcv(jpr_itx1)%laction ) THEN ! ice stress received ! 1168 ! ! ======================= ! 928 1169 ! 929 1170 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere … … 961 1202 ! 962 1203 ENDIF 963 964 1204 ! ! ======================= ! 965 1205 ! ! put on ice grid ! … … 1076 1316 ENDIF 1077 1317 ! 1078 CALL wrk_dealloc( jpi,jpj, ztx, zty )1079 ! 1080 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_tau')1318 CALL wrk_dealloc( jpi,jpj, ztx, zty ) 1319 ! 1320 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_tau') 1081 1321 ! 1082 1322 END SUBROUTINE sbc_cpl_ice_tau 1083 1323 1084 1324 1085 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist)1325 SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist ) 1086 1326 !!---------------------------------------------------------------------- 1087 1327 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1123 1363 !! sprecip solid precipitation over the ocean 1124 1364 !!---------------------------------------------------------------------- 1125 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction[0 to 1]1365 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1126 1366 ! optional arguments, used only in 'mixed oce-ice' case 1127 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! ice albedo1128 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celcius]1129 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature 1367 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1368 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1369 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1130 1370 ! 1131 1371 INTEGER :: jl ! dummy loop index 1132 REAL(wp), POINTER, DIMENSION(:,:) :: zcptn, ztmp, zicefr 1372 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk 1373 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot 1374 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice 1375 REAL(wp), POINTER, DIMENSION(:,: ) :: zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM3 1133 1376 !!---------------------------------------------------------------------- 1134 1377 ! 1135 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1136 ! 1137 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr ) 1138 1378 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1379 ! 1380 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1381 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1382 1383 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 1139 1384 zicefr(:,:) = 1.- p_frld(:,:) 1140 1385 zcptn(:,:) = rcp * sst_m(:,:) … … 1144 1389 ! ! ========================= ! 1145 1390 ! 1146 ! ! total Precipitations - total Evaporation (emp_tot) 1147 ! ! solid precipitation - sublimation (emp_ice) 1148 ! ! solid Precipitation (sprecip) 1391 ! ! total Precipitation - total Evaporation (emp_tot) 1392 ! ! solid precipitation - sublimation (emp_ice) 1393 ! ! solid Precipitation (sprecip) 1394 ! ! liquid + solid Precipitation (tprecip) 1149 1395 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1150 1396 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1151 sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1152 tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here 1153 emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 1154 emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1155 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1156 IF( lk_diaar5 ) CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1157 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1158 CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average) 1159 IF( lk_diaar5 ) CALL iom_put( 'hflx_evap_cea', ztmp(:,: ) * zcptn(:,:) ) ! heat flux from from evap (cell ave) 1397 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1398 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1399 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1400 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1401 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1402 IF( iom_use('hflx_rain_cea') ) & 1403 CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1404 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) & 1405 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1406 IF( iom_use('evap_ao_cea' ) ) & 1407 CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average) 1408 IF( iom_use('hflx_evap_cea') ) & 1409 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) ) ! heat flux from from evap (cell average) 1160 1410 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1161 emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1162 emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1163 sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 1411 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1412 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1413 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1414 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 1164 1415 END SELECT 1165 1416 1166 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1167 CALL iom_put( 'snow_ao_cea', sprecip(:,: ) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1168 CALL iom_put( 'snow_ai_cea', sprecip(:,: ) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1169 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1417 IF( iom_use('subl_ai_cea') ) & 1418 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1170 1419 ! 1171 1420 ! ! runoffs and calving (put in emp_tot) 1172 IF( srcv(jpr_rnf)%laction ) THEN 1173 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 1174 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers 1175 IF( lk_diaar5 ) CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers 1176 ENDIF 1421 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1177 1422 IF( srcv(jpr_cal)%laction ) THEN 1178 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1179 CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) ) 1180 ENDIF 1181 ! 1182 !!gm : this seems to be internal cooking, not sure to need that in a generic interface 1183 !!gm at least should be optional... 1184 !! ! remove negative runoff ! sum over the global domain 1185 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 1186 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 1187 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) 1188 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 1189 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 1190 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 1191 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 1192 !! ENDIF 1193 !! emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) ! add runoff to e-p 1194 !! 1195 !!gm end of internal cooking 1423 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1424 CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 1425 ENDIF 1426 1427 IF( ln_mixcpl ) THEN 1428 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1429 emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1430 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1431 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1432 ELSE 1433 emp_tot(:,:) = zemp_tot(:,:) 1434 emp_ice(:,:) = zemp_ice(:,:) 1435 sprecip(:,:) = zsprecip(:,:) 1436 tprecip(:,:) = ztprecip(:,:) 1437 ENDIF 1438 1439 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1440 IF( iom_use('snow_ao_cea') ) & 1441 CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1442 IF( iom_use('snow_ai_cea') ) & 1443 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1196 1444 1197 1445 ! ! ========================= ! … … 1199 1447 ! ! ========================= ! 1200 1448 CASE( 'oce only' ) ! the required field is directly provided 1201 qns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1)1449 zqns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1) 1202 1450 CASE( 'conservative' ) ! the required fields are directly provided 1203 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)1451 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1204 1452 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1205 qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)1453 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1206 1454 ELSE 1207 1455 ! Set all category values equal for the moment 1208 1456 DO jl=1,jpl 1209 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)1457 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1210 1458 ENDDO 1211 1459 ENDIF 1212 1460 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1213 qns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)1461 zqns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1214 1462 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1215 1463 DO jl=1,jpl 1216 qns_tot(:,: ) =qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)1217 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)1464 zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) 1465 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 1218 1466 ENDDO 1219 1467 ELSE 1468 qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1220 1469 DO jl=1,jpl 1221 qns_tot(:,: ) =qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1222 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)1470 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1471 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1223 1472 ENDDO 1224 1473 ENDIF 1225 1474 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1226 1475 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1227 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)1228 qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) &1476 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1477 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1229 1478 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1230 1479 & + pist(:,:,1) * zicefr(:,:) ) ) 1231 1480 END SELECT 1232 ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus1233 qns_tot(:,:) = qns_tot(:,:) & ! qns_tot update over free ocean with:1234 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting1235 & - ( emp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST)1236 & - emp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:)1237 IF( lk_diaar5 ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average)1238 1481 !!gm 1239 !! currently it is taken into account in leads budget but not in the qns_tot, and thus not in1482 !! currently it is taken into account in leads budget but not in the zqns_tot, and thus not in 1240 1483 !! the flux that enter the ocean.... 1241 1484 !! moreover 1 - it is not diagnose anywhere.... … … 1246 1489 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1247 1490 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1248 qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 1249 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1250 ENDIF 1251 1491 zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 1492 IF( iom_use('hflx_cal_cea') ) & 1493 CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1494 ENDIF 1495 1496 ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 1497 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1498 1499 #if defined key_lim3 1500 CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1501 1502 ! --- evaporation --- ! 1503 ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation 1504 ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice 1505 ! but it is incoherent WITH the ice model 1506 DO jl=1,jpl 1507 evap_ice(:,:,jl) = 0._wp ! should be: frcv(jpr_ievp)%z3(:,:,1) 1508 ENDDO 1509 zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 1510 1511 ! --- evaporation minus precipitation --- ! 1512 emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:) 1513 1514 ! --- non solar flux over ocean --- ! 1515 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax 1516 zqns_oce = 0._wp 1517 WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 1518 1519 ! --- heat flux associated with emp --- ! 1520 zsnw(:,:) = 0._wp 1521 CALL lim_thd_snwblow( p_frld, zsnw ) ! snow distribution over ice after wind blowing 1522 zqemp_oce(:,:) = - zevap(:,:) * p_frld(:,:) * zcptn(:,:) & ! evap 1523 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip 1524 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 1525 qemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1526 & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1527 1528 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1529 zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 1530 1531 ! --- total non solar flux --- ! 1532 zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:) 1533 1534 ! --- in case both coupled/forced are active, we must mix values --- ! 1535 IF( ln_mixcpl ) THEN 1536 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 1537 qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:) 1538 DO jl=1,jpl 1539 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1540 ENDDO 1541 qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:) 1542 qemp_oce (:,:) = qemp_oce(:,:) * xcplmask(:,:,0) + zqemp_oce(:,:)* zmsk(:,:) 1543 !!clem evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0) 1544 ELSE 1545 qns_tot (:,: ) = zqns_tot (:,: ) 1546 qns_oce (:,: ) = zqns_oce (:,: ) 1547 qns_ice (:,:,:) = zqns_ice (:,:,:) 1548 qprec_ice(:,:) = zqprec_ice(:,:) 1549 qemp_oce (:,:) = zqemp_oce (:,:) 1550 ENDIF 1551 1552 CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1553 #else 1554 ! 1555 ! clem: this formulation is certainly wrong... but better than it was before... 1556 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1557 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting 1558 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1559 & - zemp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:) 1560 1561 IF( ln_mixcpl ) THEN 1562 qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1563 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 1564 DO jl=1,jpl 1565 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1566 ENDDO 1567 ELSE 1568 qns_tot(:,: ) = zqns_tot(:,: ) 1569 qns_ice(:,:,:) = zqns_ice(:,:,:) 1570 ENDIF 1571 ! 1572 #endif 1252 1573 ! ! ========================= ! 1253 1574 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr) 1254 1575 ! ! ========================= ! 1255 1576 CASE( 'oce only' ) 1256 qsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )1577 zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 1257 1578 CASE( 'conservative' ) 1258 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1579 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1259 1580 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1260 qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)1581 zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 1261 1582 ELSE 1262 1583 ! Set all category values equal for the moment 1263 1584 DO jl=1,jpl 1264 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)1585 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1265 1586 ENDDO 1266 1587 ENDIF 1267 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1268 qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)1588 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1589 zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1269 1590 CASE( 'oce and ice' ) 1270 qsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)1591 zqsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1271 1592 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1272 1593 DO jl=1,jpl 1273 qsr_tot(:,: ) =qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)1274 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)1594 zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) 1595 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 1275 1596 ENDDO 1276 1597 ELSE 1598 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1277 1599 DO jl=1,jpl 1278 qsr_tot(:,: ) =qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1279 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)1600 zqsr_tot(:,: ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1601 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1280 1602 ENDDO 1281 1603 ENDIF 1282 1604 CASE( 'mixed oce-ice' ) 1283 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1605 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1284 1606 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1285 1607 ! Create solar heat flux over ice using incoming solar heat flux and albedos 1286 1608 ! ( see OASIS3 user guide, 5th edition, p39 ) 1287 qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) &1609 zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1288 1610 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) & 1289 1611 & + palbi (:,:,1) * zicefr(:,:) ) ) 1290 1612 END SELECT 1291 IF( ln_dm2dc ) THEN ! modify qsr to include the diurnal cycle1292 qsr_tot(:,: ) = sbc_dcy(qsr_tot(:,: ) )1613 IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle 1614 zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) ) 1293 1615 DO jl=1,jpl 1294 qsr_ice(:,:,jl) = sbc_dcy(qsr_ice(:,:,jl) )1616 zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) ) 1295 1617 ENDDO 1296 1618 ENDIF 1297 1619 1298 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 1620 #if defined key_lim3 1621 CALL wrk_alloc( jpi,jpj, zqsr_oce ) 1622 ! --- solar flux over ocean --- ! 1623 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax 1624 zqsr_oce = 0._wp 1625 WHERE( p_frld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:) 1626 1627 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) 1628 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF 1629 1630 CALL wrk_dealloc( jpi,jpj, zqsr_oce ) 1631 #endif 1632 1633 IF( ln_mixcpl ) THEN 1634 qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1635 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:) 1636 DO jl=1,jpl 1637 qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:) 1638 ENDDO 1639 ELSE 1640 qsr_tot(:,: ) = zqsr_tot(:,: ) 1641 qsr_ice(:,:,:) = zqsr_ice(:,:,:) 1642 ENDIF 1643 1644 ! ! ========================= ! 1645 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt ! 1646 ! ! ========================= ! 1299 1647 CASE ('coupled') 1300 1648 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 1301 dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)1649 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 1302 1650 ELSE 1303 1651 ! Set all category values equal for the moment 1304 1652 DO jl=1,jpl 1305 dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)1653 zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 1306 1654 ENDDO 1307 1655 ENDIF 1308 1656 END SELECT 1309 1310 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 1657 1658 IF( ln_mixcpl ) THEN 1659 DO jl=1,jpl 1660 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:) 1661 ENDDO 1662 ELSE 1663 dqns_ice(:,:,:) = zdqns_ice(:,:,:) 1664 ENDIF 1665 1666 ! ! ========================= ! 1667 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt ! 1668 ! ! ========================= ! 1311 1669 CASE ('coupled') 1312 1670 topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) … … 1314 1672 END SELECT 1315 1673 1316 ! Ice Qsr penetration used (only?)in lim2 or lim3 1317 ! fraction of net shortwave radiation which is not absorbed in the thin surface layer 1318 ! and penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 1674 ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 ) 1675 ! Used for LIM2 and LIM3 1319 1676 ! Coupled case: since cloud cover is not received from atmosphere 1320 ! ===> defined as constant value -> definition done in sbc_cpl_init1321 fr1_i0(:,:) = 0.181322 fr2_i0(:,:) = 0.821323 1324 1325 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr)1326 ! 1327 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx')1677 ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 1678 fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 1679 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1680 1681 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1682 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1683 ! 1684 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') 1328 1685 ! 1329 1686 END SUBROUTINE sbc_cpl_ice_flx … … 1336 1693 !! ** Purpose : provide the ocean-ice informations to the atmosphere 1337 1694 !! 1338 !! ** Method : send to the atmosphere through a call to cpl_ prism_snd1695 !! ** Method : send to the atmosphere through a call to cpl_snd 1339 1696 !! all the needed fields (as defined in sbc_cpl_init) 1340 1697 !!---------------------------------------------------------------------- … … 1343 1700 INTEGER :: ji, jj, jl ! dummy loop indices 1344 1701 INTEGER :: isec, info ! local integer 1702 REAL(wp) :: zumax, zvmax 1345 1703 REAL(wp), POINTER, DIMENSION(:,:) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 1346 1704 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp3, ztmp4 1347 1705 !!---------------------------------------------------------------------- 1348 1706 ! 1349 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_snd')1350 ! 1351 CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )1352 CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 )1353 1354 isec = ( kt - nit000 ) * NINT( rdttra(1)) ! date of exchanges1707 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_snd') 1708 ! 1709 CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 1710 CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 1711 1712 isec = ( kt - nit000 ) * NINT( rdt ) ! date of exchanges 1355 1713 1356 1714 zfr_l(:,:) = 1.- fr_i(:,:) 1357 1358 1715 ! ! ------------------------- ! 1359 1716 ! ! Surface temperature ! in Kelvin 1360 1717 ! ! ------------------------- ! 1361 1718 IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 1362 SELECT CASE( sn_snd_temp%cldes) 1363 CASE( 'oce only' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 1364 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1365 SELECT CASE( sn_snd_temp%clcat ) 1719 1720 IF ( nn_components == jp_iam_opa ) THEN 1721 ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part 1722 ELSE 1723 ! we must send the surface potential temperature 1724 IF( ln_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 1725 ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem) 1726 ENDIF 1727 ! 1728 SELECT CASE( sn_snd_temp%cldes) 1729 CASE( 'oce only' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0 1730 CASE( 'oce and ice' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0 1731 SELECT CASE( sn_snd_temp%clcat ) 1732 CASE( 'yes' ) 1733 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) 1734 CASE( 'no' ) 1735 WHERE( SUM( a_i, dim=3 ) /= 0. ) 1736 ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1737 ELSEWHERE 1738 ztmp3(:,:,1) = rt0 1739 END WHERE 1740 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1741 END SELECT 1742 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 1743 SELECT CASE( sn_snd_temp%clcat ) 1744 CASE( 'yes' ) 1745 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1746 CASE( 'no' ) 1747 ztmp3(:,:,:) = 0.0 1748 DO jl=1,jpl 1749 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 1750 ENDDO 1751 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1752 END SELECT 1753 CASE( 'mixed oce-ice' ) 1754 ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 1755 DO jl=1,jpl 1756 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1757 ENDDO 1758 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1759 END SELECT 1760 ENDIF 1761 IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1762 IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info ) 1763 IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1764 ENDIF 1765 ! ! ------------------------- ! 1766 ! ! Albedo ! 1767 ! ! ------------------------- ! 1768 IF( ssnd(jps_albice)%laction ) THEN ! ice 1769 SELECT CASE( sn_snd_alb%cldes ) 1770 CASE( 'ice' ) 1771 SELECT CASE( sn_snd_alb%clcat ) 1772 CASE( 'yes' ) 1773 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 1774 CASE( 'no' ) 1775 WHERE( SUM( a_i, dim=3 ) /= 0. ) 1776 ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 ) 1777 ELSEWHERE 1778 ztmp1(:,:) = albedo_oce_mix(:,:) 1779 END WHERE 1780 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' ) 1781 END SELECT 1782 CASE( 'weighted ice' ) ; 1783 SELECT CASE( sn_snd_alb%clcat ) 1784 CASE( 'yes' ) 1785 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1786 CASE( 'no' ) 1787 WHERE( fr_i (:,:) > 0. ) 1788 ztmp1(:,:) = SUM ( alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) 1789 ELSEWHERE 1790 ztmp1(:,:) = 0. 1791 END WHERE 1792 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' ) 1793 END SELECT 1794 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 1795 END SELECT 1796 1797 SELECT CASE( sn_snd_alb%clcat ) 1366 1798 CASE( 'yes' ) 1367 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1368 CASE( 'no' ) 1369 ztmp3(:,:,:) = 0.0 1370 DO jl=1,jpl 1371 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 1372 ENDDO 1373 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1374 END SELECT 1375 CASE( 'mixed oce-ice' ) 1376 ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1377 DO jl=1,jpl 1378 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1379 ENDDO 1380 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1799 CALL cpl_snd( jps_albice, isec, ztmp3, info ) !-> MV this has never been checked in coupled mode 1800 CASE( 'no' ) 1801 CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1381 1802 END SELECT 1382 IF( ssnd(jps_toce)%laction ) CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1383 IF( ssnd(jps_tice)%laction ) CALL cpl_prism_snd( jps_tice, isec, ztmp3, info ) 1384 IF( ssnd(jps_tmix)%laction ) CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1385 ENDIF 1386 ! 1387 ! ! ------------------------- ! 1388 ! ! Albedo ! 1389 ! ! ------------------------- ! 1390 IF( ssnd(jps_albice)%laction ) THEN ! ice 1391 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1392 CALL cpl_prism_snd( jps_albice, isec, ztmp3, info ) 1393 ENDIF 1803 ENDIF 1804 1394 1805 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean 1395 1806 ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) … … 1397 1808 ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 1398 1809 ENDDO 1399 CALL cpl_ prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )1810 CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1400 1811 ENDIF 1401 1812 ! ! ------------------------- ! 1402 1813 ! ! Ice fraction & Thickness ! 1403 1814 ! ! ------------------------- ! 1404 ! Send ice fraction field 1815 ! Send ice fraction field to atmosphere 1405 1816 IF( ssnd(jps_fice)%laction ) THEN 1406 1817 SELECT CASE( sn_snd_thick%clcat ) … … 1409 1820 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1410 1821 END SELECT 1411 CALL cpl_prism_snd( jps_fice, isec, ztmp3, info ) 1822 IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info ) 1823 ENDIF 1824 1825 ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling) 1826 IF( ssnd(jps_fice2)%laction ) THEN 1827 ztmp3(:,:,1) = fr_i(:,:) 1828 IF( ssnd(jps_fice2)%laction ) CALL cpl_snd( jps_fice2, isec, ztmp3, info ) 1412 1829 ENDIF 1413 1830 … … 1430 1847 END SELECT 1431 1848 CASE( 'ice and snow' ) 1432 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 1433 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 1849 SELECT CASE( sn_snd_thick%clcat ) 1850 CASE( 'yes' ) 1851 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 1852 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 1853 CASE( 'no' ) 1854 WHERE( SUM( a_i, dim=3 ) /= 0. ) 1855 ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1856 ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1857 ELSEWHERE 1858 ztmp3(:,:,1) = 0. 1859 ztmp4(:,:,1) = 0. 1860 END WHERE 1861 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1862 END SELECT 1434 1863 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 1435 1864 END SELECT 1436 IF( ssnd(jps_hice)%laction ) CALL cpl_ prism_snd( jps_hice, isec, ztmp3, info )1437 IF( ssnd(jps_hsnw)%laction ) CALL cpl_ prism_snd( jps_hsnw, isec, ztmp4, info )1865 IF( ssnd(jps_hice)%laction ) CALL cpl_snd( jps_hice, isec, ztmp3, info ) 1866 IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 1438 1867 ENDIF 1439 1868 ! … … 1442 1871 ! ! CO2 flux from PISCES ! 1443 1872 ! ! ------------------------- ! 1444 IF( ssnd(jps_co2)%laction ) CALL cpl_ prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )1873 IF( ssnd(jps_co2)%laction ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 1445 1874 ! 1446 1875 #endif … … 1457 1886 ! i-1 i i 1458 1887 ! i i+1 (for I) 1459 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1460 CASE( 'oce only' ) ! C-grid ==> T 1461 DO jj = 2, jpjm1 1462 DO ji = fs_2, fs_jpim1 ! vector opt. 1463 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1464 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1465 END DO 1466 END DO 1467 CASE( 'weighted oce and ice' ) 1468 SELECT CASE ( cp_ice_msh ) 1469 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1888 IF( nn_components == jp_iam_opa ) THEN 1889 zotx1(:,:) = un(:,:,1) 1890 zoty1(:,:) = vn(:,:,1) 1891 ELSE 1892 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1893 CASE( 'oce only' ) ! C-grid ==> T 1470 1894 DO jj = 2, jpjm1 1471 1895 DO ji = fs_2, fs_jpim1 ! vector opt. 1472 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 1473 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 1474 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1475 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1896 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1897 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1476 1898 END DO 1477 1899 END DO 1478 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1479 DO jj = 2, jpjm1 1480 DO ji = 2, jpim1 ! NO vector opt. 1481 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 1482 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1483 zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1484 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1485 zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1486 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1900 CASE( 'weighted oce and 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 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 1907 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1908 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1909 END DO 1487 1910 END DO 1488 END DO1489 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T1490 DO jj = 2, jpjm11491 DO ji = 2, jpim1 ! NO vector opt.1492 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj,1) ) * zfr_l(ji,jj)1493 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj)1494 zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) &1495 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)1496 zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) &1497 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)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 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1916 zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1917 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1918 zity1(ji,jj) = 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 1498 1921 END DO 1499 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 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1927 zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1928 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1929 zity1(ji,jj) = 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 1934 CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. ) 1935 CASE( 'mixed oce-ice' ) 1936 SELECT CASE ( cp_ice_msh ) 1937 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1938 DO jj = 2, jpjm1 1939 DO ji = fs_2, fs_jpim1 ! vector opt. 1940 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 1941 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1942 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 1943 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1944 END DO 1945 END DO 1946 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1947 DO jj = 2, jpjm1 1948 DO ji = 2, jpim1 ! NO vector opt. 1949 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1950 & + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1951 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1952 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1953 & + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1954 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1955 END DO 1956 END DO 1957 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1958 DO jj = 2, jpjm1 1959 DO ji = 2, jpim1 ! NO vector opt. 1960 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1961 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1962 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1963 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1964 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1965 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1966 END DO 1967 END DO 1968 END SELECT 1500 1969 END SELECT 1501 CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. ) 1502 CASE( 'mixed oce-ice' ) 1503 SELECT CASE ( cp_ice_msh ) 1504 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1505 DO jj = 2, jpjm1 1506 DO ji = fs_2, fs_jpim1 ! vector opt. 1507 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 1508 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1509 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 1510 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1511 END DO 1512 END DO 1513 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1514 DO jj = 2, jpjm1 1515 DO ji = 2, jpim1 ! NO vector opt. 1516 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1517 & + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1518 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1519 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1520 & + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1521 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1522 END DO 1523 END DO 1524 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1525 DO jj = 2, jpjm1 1526 DO ji = 2, jpim1 ! NO vector opt. 1527 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1528 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1529 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1530 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1531 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1532 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1533 END DO 1534 END DO 1535 END SELECT 1536 END SELECT 1537 CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 1970 CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 1971 ! 1972 ENDIF 1538 1973 ! 1539 1974 ! … … 1565 2000 ENDIF 1566 2001 ! 1567 IF( ssnd(jps_ocx1)%laction ) CALL cpl_ prism_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid1568 IF( ssnd(jps_ocy1)%laction ) CALL cpl_ prism_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid1569 IF( ssnd(jps_ocz1)%laction ) CALL cpl_ prism_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid2002 IF( ssnd(jps_ocx1)%laction ) CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid 2003 IF( ssnd(jps_ocy1)%laction ) CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid 2004 IF( ssnd(jps_ocz1)%laction ) CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid 1570 2005 ! 1571 IF( ssnd(jps_ivx1)%laction ) CALL cpl_ prism_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid1572 IF( ssnd(jps_ivy1)%laction ) CALL cpl_ prism_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid1573 IF( ssnd(jps_ivz1)%laction ) CALL cpl_ prism_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid2006 IF( ssnd(jps_ivx1)%laction ) CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid 2007 IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid 2008 IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid 1574 2009 ! 1575 2010 ENDIF 1576 2011 ! 1577 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 1578 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 1579 ! 1580 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_snd') 2012 ! 2013 ! Fields sent by OPA to SAS when doing OPA<->SAS coupling 2014 ! ! SSH 2015 IF( ssnd(jps_ssh )%laction ) THEN 2016 ! ! removed inverse barometer ssh when Patm 2017 ! forcing is used (for sea-ice dynamics) 2018 IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 2019 ELSE ; ztmp1(:,:) = sshn(:,:) 2020 ENDIF 2021 CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info ) 2022 2023 ENDIF 2024 ! ! SSS 2025 IF( ssnd(jps_soce )%laction ) THEN 2026 CALL cpl_snd( jps_soce , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info ) 2027 ENDIF 2028 ! ! first T level thickness 2029 IF( ssnd(jps_e3t1st )%laction ) THEN 2030 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t_n(:,:,1) , (/jpi,jpj,1/) ), info ) 2031 ENDIF 2032 ! ! Qsr fraction 2033 IF( ssnd(jps_fraqsr)%laction ) THEN 2034 CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info ) 2035 ENDIF 2036 ! 2037 ! Fields sent by SAS to OPA when OASIS coupling 2038 ! ! Solar heat flux 2039 IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info ) 2040 IF( ssnd(jps_qnsoce)%laction ) CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info ) 2041 IF( ssnd(jps_oemp )%laction ) CALL cpl_snd( jps_oemp , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info ) 2042 IF( ssnd(jps_sflx )%laction ) CALL cpl_snd( jps_sflx , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info ) 2043 IF( ssnd(jps_otx1 )%laction ) CALL cpl_snd( jps_otx1 , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info ) 2044 IF( ssnd(jps_oty1 )%laction ) CALL cpl_snd( jps_oty1 , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info ) 2045 IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) 2046 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 2047 2048 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 2049 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 2050 ! 2051 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_snd') 1581 2052 ! 1582 2053 END SUBROUTINE sbc_cpl_snd 1583 2054 1584 #else1585 !!----------------------------------------------------------------------1586 !! Dummy module NO coupling1587 !!----------------------------------------------------------------------1588 USE par_kind ! kind definition1589 CONTAINS1590 SUBROUTINE sbc_cpl_snd( kt )1591 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt1592 END SUBROUTINE sbc_cpl_snd1593 !1594 SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )1595 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt, k_fsbc, k_ice1596 END SUBROUTINE sbc_cpl_rcv1597 !1598 SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )1599 REAL(wp), INTENT(out), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2]1600 REAL(wp), INTENT(out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid)1601 p_taui(:,:) = 0. ; p_tauj(:,:) = 0. ! stupid definition to avoid warning message when compiling...1602 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?'1603 END SUBROUTINE sbc_cpl_ice_tau1604 !1605 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist )1606 REAL(wp), INTENT(in ), DIMENSION(:,: ) :: p_frld ! lead fraction [0 to 1]1607 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! ice albedo1608 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celcius]1609 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin]1610 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1), palbi(1,1,1), psst(1,1), pist(1,1,1)1611 END SUBROUTINE sbc_cpl_ice_flx1612 1613 #endif1614 1615 2055 !!====================================================================== 1616 2056 END MODULE sbccpl
Note: See TracChangeset
for help on using the changeset viewer.
