- Timestamp:
- 2011-11-15T21:55:40+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r2977 r3116 7 7 !! 3.0 ! 2008-02 (G. Madec, C Talandier) surface module 8 8 !! 3.1 ! 2009_02 (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface 9 !! 3.4 ! 2011_11 (C. Harris) more flexibility + multi-category fields 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_oasis3 || defined key_oasis4 … … 51 52 #endif 52 53 USE diaar5, ONLY : lk_diaar5 54 #if defined key_cice 55 USE ice_domain_size, only: ncat 56 #endif 53 57 IMPLICIT NONE 54 58 PRIVATE … … 89 93 INTEGER, PARAMETER :: jpr_cal = 29 ! calving 90 94 INTEGER, PARAMETER :: jpr_taum = 30 ! wind stress module 91 #if ! defined key_cpl_carbon_cycle92 INTEGER, PARAMETER :: jprcv = 30 ! total number of fields received93 #else94 95 INTEGER, PARAMETER :: jpr_co2 = 31 95 INTEGER, PARAMETER :: jprcv = 31 ! total number of fields received 96 #endif 96 INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn 97 INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn 98 INTEGER, PARAMETER :: jprcv = 33 ! total number of fields received 99 97 100 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction 98 101 INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature … … 109 112 INTEGER, PARAMETER :: jps_ivy1 = 13 ! 110 113 INTEGER, PARAMETER :: jps_ivz1 = 14 ! 111 #if ! defined key_cpl_carbon_cycle112 INTEGER, PARAMETER :: jpsnd = 14 ! total number of fields sended113 #else114 114 INTEGER, PARAMETER :: jps_co2 = 15 115 115 INTEGER, PARAMETER :: jpsnd = 15 ! total number of fields sended 116 #endif 116 117 117 ! !!** namelist namsbc_cpl ** 118 ! Send to the atmosphere ! 119 CHARACTER(len=100) :: cn_snd_temperature = 'oce only' ! 'oce only' 'weighted oce and ice' or 'mixed oce-ice' 120 CHARACTER(len=100) :: cn_snd_albedo = 'none' ! 'none' 'weighted ice' or 'mixed oce-ice' 121 CHARACTER(len=100) :: cn_snd_thickness = 'none' ! 'none' or 'weighted ice and snow' 122 CHARACTER(len=100) :: cn_snd_crt_nature = 'none' ! 'none' 'oce only' 'weighted oce and ice' or 'mixed oce-ice' 123 CHARACTER(len=100) :: cn_snd_crt_refere = 'spherical' ! 'spherical' or 'cartesian' 124 CHARACTER(len=100) :: cn_snd_crt_orient = 'local grid' ! 'eastward-northward' or 'local grid' 125 CHARACTER(len=100) :: cn_snd_crt_grid = 'T' ! always at 'T' point 126 #if defined key_cpl_carbon_cycle 127 CHARACTER(len=100) :: cn_snd_co2 = 'none' ! 'none' or 'coupled' 118 TYPE :: FLD_C 119 CHARACTER(len = 32) :: cldes ! desciption of the coupling strategy 120 CHARACTER(len = 32) :: clcat ! multiple ice categories strategy 121 CHARACTER(len = 32) :: clvref ! reference of vector ('spherical' or 'cartesian') 122 CHARACTER(len = 32) :: clvor ! orientation of vector fields ('eastward-northward' or 'local grid') 123 CHARACTER(len = 32) :: clvgrd ! grids on which is located the vector fields 124 END TYPE FLD_C 125 ! Send to the atmosphere ! 126 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 127 ! Received from the atmosphere ! 128 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 129 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 130 131 TYPE :: DYNARR 132 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 133 END TYPE DYNARR 134 135 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere 136 137 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 138 139 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument 140 141 #if ! defined key_lim2 && ! defined key_lim3 142 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 143 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice, alb_ice, qns_ice, dqns_ice ! (jpi,jpj,jpl) 128 144 #endif 129 ! Received from the atmosphere ! 130 CHARACTER(len=100) :: cn_rcv_tau_nature = 'oce only' ! 'oce only' 'oce and ice' or 'mixed oce-ice' 131 CHARACTER(len=100) :: cn_rcv_tau_refere = 'spherical' ! 'spherical' or 'cartesian' 132 CHARACTER(len=100) :: cn_rcv_tau_orient = 'local grid' ! 'eastward-northward' or 'local grid' 133 CHARACTER(len=100) :: cn_rcv_tau_grid = 'T' ! 'T', 'U,V', 'U,V,I', 'T,I', or 'T,U,V' 134 CHARACTER(len=100) :: cn_rcv_w10m = 'none' ! 'none' or 'coupled' 135 CHARACTER(len=100) :: cn_rcv_dqnsdt = 'none' ! 'none' or 'coupled' 136 CHARACTER(len=100) :: cn_rcv_qsr = 'oce only' ! 'oce only' 'conservative' 'oce and ice' or 'mixed oce-ice' 137 CHARACTER(len=100) :: cn_rcv_qns = 'oce only' ! 'oce only' 'conservative' 'oce and ice' or 'mixed oce-ice' 138 CHARACTER(len=100) :: cn_rcv_emp = 'oce only' ! 'oce only' 'conservative' or 'oce and ice' 139 CHARACTER(len=100) :: cn_rcv_rnf = 'coupled' ! 'coupled' 'climato' or 'mixed' 140 CHARACTER(len=100) :: cn_rcv_cal = 'none' ! 'none' or 'coupled' 141 CHARACTER(len=100) :: cn_rcv_taumod = 'none' ! 'none' or 'coupled' 142 #if defined key_cpl_carbon_cycle 143 CHARACTER(len=100) :: cn_rcv_co2 = 'none' ! 'none' or 'coupled' 145 146 #if defined key_cice 147 INTEGER, PARAMETER :: jpl = ncat 148 #elif ! defined key_lim2 && ! defined key_lim3 149 INTEGER, PARAMETER :: jpl = 1 150 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice 151 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice 144 152 #endif 145 153 146 !! CHARACTER(len=100), PUBLIC :: cn_rcv_rnf !: ??? ==>> !!gm treat this case in a different maner 147 148 CHARACTER(len=100), DIMENSION(4) :: cn_snd_crt ! array combining cn_snd_crt_* 149 CHARACTER(len=100), DIMENSION(4) :: cn_rcv_tau ! array combining cn_rcv_tau_* 150 151 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 152 153 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: frcv ! all fields recieved from the atmosphere 154 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument 155 156 #if ! defined key_lim2 && ! defined key_lim3 157 ! quick patch to be able to run the coupled model without sea-ice... 158 INTEGER, PARAMETER :: jpl = 1 159 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: hicif, hsnif, u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 160 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice, alb_ice ! (jpi,jpj,jpl) 161 REAL(wp) :: lfus 154 #if ! defined key_lim3 && ! defined key_cice 155 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i 156 #endif 157 158 #if ! defined key_lim3 159 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i, ht_s 160 #endif 161 162 #if ! defined key_cice 163 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt, botmelt 162 164 #endif 163 165 … … 176 178 !! *** FUNCTION sbc_cpl_alloc *** 177 179 !!---------------------------------------------------------------------- 178 INTEGER :: ierr( 2)180 INTEGER :: ierr(4),jn 179 181 !!---------------------------------------------------------------------- 180 182 ierr(:) = 0 181 183 ! 182 ALLOCATE( albedo_oce_mix(jpi,jpj), frcv(jpi,jpj,jprcv),nrcvinfo(jprcv), STAT=ierr(1) )184 ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) ) 183 185 ! 184 186 #if ! defined key_lim2 && ! defined key_lim3 185 187 ! quick patch to be able to run the coupled model without sea-ice... 186 ALLOCATE( hicif(jpi,jpj) , u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,jpl) , & 187 hsnif(jpi,jpj) , v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,jpl) , STAT=ierr(2) ) 188 ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , & 189 v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1), & 190 emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , STAT=ierr(2) ) 191 #endif 192 193 #if ! defined key_lim3 && ! defined key_cice 194 ALLOCATE( a_i(jpi,jpj,jpl) , STAT=ierr(3) ) 195 #endif 196 197 #if defined key_cice || defined key_lim2 198 ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(4) ) 188 199 #endif 189 200 sbc_cpl_alloc = MAXVAL( ierr ) … … 213 224 INTEGER :: jn ! dummy loop index 214 225 !! 215 NAMELIST/namsbc_cpl/ cn_snd_temperature, cn_snd_albedo , cn_snd_thickness, & 216 cn_snd_crt_nature, cn_snd_crt_refere , cn_snd_crt_orient, cn_snd_crt_grid , & 217 cn_rcv_w10m , cn_rcv_taumod , & 218 cn_rcv_tau_nature, cn_rcv_tau_refere , cn_rcv_tau_orient, cn_rcv_tau_grid , & 219 cn_rcv_dqnsdt , cn_rcv_qsr , cn_rcv_qns , cn_rcv_emp , cn_rcv_rnf , cn_rcv_cal 220 #if defined key_cpl_carbon_cycle 221 NAMELIST/namsbc_cpl_co2/ cn_snd_co2, cn_rcv_co2 222 #endif 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 223 229 !!--------------------------------------------------------------------- 224 230 … … 230 236 ! Namelist informations ! 231 237 ! ================================ ! 238 239 ! default definitions 240 ! ! description ! multiple ! vector ! vector ! vector ! 241 ! ! ! categories ! reference ! orientation ! grids ! 242 ! send 243 sn_snd_temp = FLD_C( 'weighted oce and ice', 'no' , '' , '' , '' ) 244 sn_snd_alb = FLD_C( 'weighted ice' , 'no' , '' , '' , '' ) 245 sn_snd_thick = FLD_C( 'none' , 'no' , '' , '' , '' ) 246 sn_snd_crt = FLD_C( 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' ) 247 sn_snd_co2 = FLD_C( 'none' , 'no' , '' , '' , '' ) 248 ! receive 249 sn_rcv_w10m = FLD_C( 'none' , 'no' , '' , '' , '' ) 250 sn_rcv_taumod = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 251 sn_rcv_tau = FLD_C( 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' ) 252 sn_rcv_dqnsdt = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 253 sn_rcv_qsr = FLD_C( 'oce and ice' , 'no' , '' , '' , '' ) 254 sn_rcv_qns = FLD_C( 'oce and ice' , 'no' , '' , '' , '' ) 255 sn_rcv_emp = FLD_C( 'conservative' , 'no' , '' , '' , '' ) 256 sn_rcv_rnf = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 257 sn_rcv_cal = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 258 sn_rcv_iceflx = FLD_C( 'none' , 'no' , '' , '' , '' ) 259 sn_rcv_co2 = FLD_C( 'none' , 'no' , '' , '' , '' ) 232 260 233 261 REWIND( numnam ) ! ... read namlist namsbc_cpl … … 238 266 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 239 267 WRITE(numout,*)'~~~~~~~~~~~~' 240 WRITE(numout,*)' received fields' 241 WRITE(numout,*)' 10m wind module cn_rcv_w10m = ', cn_rcv_w10m 242 WRITE(numout,*)' surface stress - nature cn_rcv_tau_nature = ', cn_rcv_tau_nature 243 WRITE(numout,*)' - referential cn_rcv_tau_refere = ', cn_rcv_tau_refere 244 WRITE(numout,*)' - orientation cn_rcv_tau_orient = ', cn_rcv_tau_orient 245 WRITE(numout,*)' - mesh cn_rcv_tau_grid = ', cn_rcv_tau_grid 246 WRITE(numout,*)' non-solar heat flux sensitivity cn_rcv_dqnsdt = ', cn_rcv_dqnsdt 247 WRITE(numout,*)' solar heat flux cn_rcv_qsr = ', cn_rcv_qsr 248 WRITE(numout,*)' non-solar heat flux cn_rcv_qns = ', cn_rcv_qns 249 WRITE(numout,*)' freshwater budget cn_rcv_emp = ', cn_rcv_emp 250 WRITE(numout,*)' runoffs cn_rcv_rnf = ', cn_rcv_rnf 251 WRITE(numout,*)' calving cn_rcv_cal = ', cn_rcv_cal 252 WRITE(numout,*)' stress module cn_rcv_taumod = ', cn_rcv_taumod 253 WRITE(numout,*)' sent fields' 254 WRITE(numout,*)' surface temperature cn_snd_temperature = ', cn_snd_temperature 255 WRITE(numout,*)' albedo cn_snd_albedo = ', cn_snd_albedo 256 WRITE(numout,*)' ice/snow thickness cn_snd_thickness = ', cn_snd_thickness 257 WRITE(numout,*)' surface current - nature cn_snd_crt_nature = ', cn_snd_crt_nature 258 WRITE(numout,*)' - referential cn_snd_crt_refere = ', cn_snd_crt_refere 259 WRITE(numout,*)' - orientation cn_snd_crt_orient = ', cn_snd_crt_orient 260 WRITE(numout,*)' - mesh cn_snd_crt_grid = ', cn_snd_crt_grid 261 ENDIF 262 263 #if defined key_cpl_carbon_cycle 264 REWIND( numnam ) ! read namlist namsbc_cpl_co2 265 READ ( numnam, namsbc_cpl_co2 ) 266 IF(lwp) THEN ! control print 267 WRITE(numout,*) 268 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl_co2 namelist ' 269 WRITE(numout,*)'~~~~~~~~~~~~' 270 WRITE(numout,*)' received fields' 271 WRITE(numout,*)' atm co2 cn_rcv_co2 = ', cn_rcv_co2 272 WRITE(numout,*)' sent fields' 273 WRITE(numout,*)' oce co2 flux cn_snd_co2 = ', cn_snd_co2 274 WRITE(numout,*) 275 ENDIF 276 #endif 277 ! save current & stress in an array and suppress possible blank in the name 278 cn_snd_crt(1) = TRIM( cn_snd_crt_nature ) ; cn_snd_crt(2) = TRIM( cn_snd_crt_refere ) 279 cn_snd_crt(3) = TRIM( cn_snd_crt_orient ) ; cn_snd_crt(4) = TRIM( cn_snd_crt_grid ) 280 cn_rcv_tau(1) = TRIM( cn_rcv_tau_nature ) ; cn_rcv_tau(2) = TRIM( cn_rcv_tau_refere ) 281 cn_rcv_tau(3) = TRIM( cn_rcv_tau_orient ) ; cn_rcv_tau(4) = TRIM( cn_rcv_tau_grid ) 282 283 ! ! allocate zdfric arrays 268 WRITE(numout,*)' received fields (mutiple ice categogies)' 269 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' 270 WRITE(numout,*)' stress module = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')' 271 WRITE(numout,*)' surface stress = ', TRIM(sn_rcv_tau%cldes ), ' (', TRIM(sn_rcv_tau%clcat ), ')' 272 WRITE(numout,*)' - referential = ', sn_rcv_tau%clvref 273 WRITE(numout,*)' - orientation = ', sn_rcv_tau%clvor 274 WRITE(numout,*)' - mesh = ', sn_rcv_tau%clvgrd 275 WRITE(numout,*)' non-solar heat flux sensitivity = ', TRIM(sn_rcv_dqnsdt%cldes), ' (', TRIM(sn_rcv_dqnsdt%clcat), ')' 276 WRITE(numout,*)' solar heat flux = ', TRIM(sn_rcv_qsr%cldes ), ' (', TRIM(sn_rcv_qsr%clcat ), ')' 277 WRITE(numout,*)' non-solar heat flux = ', TRIM(sn_rcv_qns%cldes ), ' (', TRIM(sn_rcv_qns%clcat ), ')' 278 WRITE(numout,*)' freshwater budget = ', TRIM(sn_rcv_emp%cldes ), ' (', TRIM(sn_rcv_emp%clcat ), ')' 279 WRITE(numout,*)' runoffs = ', TRIM(sn_rcv_rnf%cldes ), ' (', TRIM(sn_rcv_rnf%clcat ), ')' 280 WRITE(numout,*)' calving = ', TRIM(sn_rcv_cal%cldes ), ' (', TRIM(sn_rcv_cal%clcat ), ')' 281 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 282 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 283 WRITE(numout,*)' sent fields (multiple ice categories)' 284 WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')' 285 WRITE(numout,*)' albedo = ', TRIM(sn_snd_alb%cldes ), ' (', TRIM(sn_snd_alb%clcat ), ')' 286 WRITE(numout,*)' ice/snow thickness = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')' 287 WRITE(numout,*)' surface current = ', TRIM(sn_snd_crt%cldes ), ' (', TRIM(sn_snd_crt%clcat ), ')' 288 WRITE(numout,*)' - referential = ', sn_snd_crt%clvref 289 WRITE(numout,*)' - orientation = ', sn_snd_crt%clvor 290 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 291 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 292 ENDIF 293 294 ! ! allocate sbccpl arrays 284 295 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 285 296 … … 294 305 295 306 ! default definitions of srcv 296 srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. 307 srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1 297 308 298 309 ! ! ------------------------- ! … … 315 326 ! 316 327 ! Vectors: change of sign at north fold ONLY if on the local grid 317 IF( TRIM( cn_rcv_tau(3)) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1.328 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 318 329 319 330 ! ! Set grid and action 320 SELECT CASE( TRIM( cn_rcv_tau(4)) ) ! 'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V'331 SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) ) ! 'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V' 321 332 CASE( 'T' ) 322 333 srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point … … 364 375 srcv(jpr_itx1:jpr_itz2)%laction = .TRUE. ! receive ice components on grid 1 & 2 365 376 CASE default 366 CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_tau(4)' )377 CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' ) 367 378 END SELECT 368 379 ! 369 IF( TRIM( cn_rcv_tau(2)) == 'spherical' ) & ! spherical: 3rd component not received380 IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' ) & ! spherical: 3rd component not received 370 381 & srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE. 371 382 ! 372 IF( TRIM( cn_rcv_tau(1)) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used383 IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used 373 384 srcv(jpr_itx1:jpr_itz2)%laction = .FALSE. ! ice components not received 374 385 srcv(jpr_itx1)%clgrid = 'U' ! ocean stress used after its transformation … … 388 399 srcv(jpr_semp)%clname = 'OISubMSn' ! ice solid water budget = sublimation - solid precipitation 389 400 srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip 390 SELECT CASE( TRIM( cn_rcv_emp) )401 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 391 402 CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE. 392 403 CASE( 'conservative' ) ; srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 393 404 CASE( 'oce and ice' ) ; srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE. 394 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_emp' )405 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 395 406 END SELECT 396 407 … … 398 409 ! ! Runoffs & Calving ! 399 410 ! ! ------------------------- ! 400 srcv(jpr_rnf )%clname = 'O_Runoff' ; IF( TRIM( cn_rcv_rnf ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 401 IF( TRIM( cn_rcv_rnf ) == 'climato' ) THEN ; ln_rnf = .TRUE. 402 ELSE ; ln_rnf = .FALSE. 403 ENDIF 404 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( cn_rcv_cal ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 411 srcv(jpr_rnf )%clname = 'O_Runoff' ; IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 412 ! This isn't right - really just want ln_rnf_emp changed 413 ! IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' ) THEN ; ln_rnf = .TRUE. 414 ! ELSE ; ln_rnf = .FALSE. 415 ! ENDIF 416 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 405 417 406 418 ! ! ------------------------- ! … … 410 422 srcv(jpr_qnsice)%clname = 'O_QnsIce' 411 423 srcv(jpr_qnsmix)%clname = 'O_QnsMix' 412 SELECT CASE( TRIM( cn_rcv_qns ) )424 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 413 425 CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE. 414 426 CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. 415 427 CASE( 'oce and ice' ) ; srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE. 416 428 CASE( 'mixed oce-ice' ) ; srcv( jpr_qnsmix )%laction = .TRUE. 417 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qns' )429 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' ) 418 430 END SELECT 419 431 IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 432 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 420 433 ! ! ------------------------- ! 421 434 ! ! solar radiation ! Qsr … … 424 437 srcv(jpr_qsrice)%clname = 'O_QsrIce' 425 438 srcv(jpr_qsrmix)%clname = 'O_QsrMix' 426 SELECT CASE( TRIM( cn_rcv_qsr) )439 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 427 440 CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE. 428 441 CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. 429 442 CASE( 'oce and ice' ) ; srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE. 430 443 CASE( 'mixed oce-ice' ) ; srcv( jpr_qsrmix )%laction = .TRUE. 431 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qsr' )444 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' ) 432 445 END SELECT 433 446 IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 447 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 434 448 ! ! ------------------------- ! 435 449 ! ! non solar sensitivity ! d(Qns)/d(T) 436 450 ! ! ------------------------- ! 437 451 srcv(jpr_dqnsdt)%clname = 'O_dQnsdT' 438 IF( TRIM( cn_rcv_dqnsdt) == 'coupled' ) srcv(jpr_dqnsdt)%laction = .TRUE.439 ! 440 ! non solar sensitivity mandatory for ice model441 IF( TRIM( cn_rcv_dqnsdt ) == 'none' .AND. k_ice /= 0) &442 CALL ctl_stop( 'sbc_cpl_init: cn_rcv_dqnsdtmust be coupled in namsbc_cpl namelist' )452 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' ) srcv(jpr_dqnsdt)%laction = .TRUE. 453 ! 454 ! non solar sensitivity mandatory for LIM ice model 455 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) & 456 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 443 457 ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique 444 IF( TRIM( cn_rcv_dqnsdt ) == 'none' .AND. TRIM( cn_rcv_qns ) == 'mixed oce-ice' ) &445 CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between cn_rcv_qns and cn_rcv_dqnsdt' )458 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) & 459 CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' ) 446 460 ! ! ------------------------- ! 447 461 ! ! Ice Qsr penetration ! … … 456 470 ! ! 10m wind module ! 457 471 ! ! ------------------------- ! 458 srcv(jpr_w10m)%clname = 'O_Wind10' ; IF( TRIM( cn_rcv_w10m) == 'coupled' ) srcv(jpr_w10m)%laction = .TRUE.472 srcv(jpr_w10m)%clname = 'O_Wind10' ; IF( TRIM(sn_rcv_w10m%cldes ) == 'coupled' ) srcv(jpr_w10m)%laction = .TRUE. 459 473 ! 460 474 ! ! ------------------------- ! 461 475 ! ! wind stress module ! 462 476 ! ! ------------------------- ! 463 srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM( cn_rcv_taumod) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE.477 srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE. 464 478 lhftau = srcv(jpr_taum)%laction 465 479 466 #if defined key_cpl_carbon_cycle467 480 ! ! ------------------------- ! 468 481 ! ! Atmospheric CO2 ! 469 482 ! ! ------------------------- ! 470 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(cn_rcv_co2 ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 471 #endif 472 483 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 484 ! ! ------------------------- ! 485 ! ! topmelt and botmelt ! 486 ! ! ------------------------- ! 487 srcv(jpr_topm )%clname = 'OTopMlt' 488 srcv(jpr_botm )%clname = 'OBotMlt' 489 IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 490 IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 491 srcv(jpr_topm:jpr_botm)%nct = jpl 492 ELSE 493 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' ) 494 ENDIF 495 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 496 ENDIF 497 498 ! Allocate all parts of frcv used for received fields 499 DO jn = 1, jprcv 500 IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 501 END DO 502 ! Allocate taum part of frcv which is used even when not received as coupling field 503 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jn)%nct) ) 504 473 505 ! ================================ ! 474 506 ! Define the send interface ! 475 507 ! ================================ ! 476 ! for each field: define the OASIS name (s rcv(:)%clname)477 ! define send or not from the namelist parameters (s rcv(:)%laction)478 ! define the north fold type of lbc (s rcv(:)%nsgn)508 ! for each field: define the OASIS name (ssnd(:)%clname) 509 ! define send or not from the namelist parameters (ssnd(:)%laction) 510 ! define the north fold type of lbc (ssnd(:)%nsgn) 479 511 480 512 ! default definitions of nsnd 481 ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. 513 ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1 482 514 483 515 ! ! ------------------------- ! … … 487 519 ssnd(jps_tice)%clname = 'O_TepIce' 488 520 ssnd(jps_tmix)%clname = 'O_TepMix' 489 SELECT CASE( TRIM( cn_snd_temperature) )521 SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 490 522 CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE. 491 CASE( 'weighted oce and ice' ) ; ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 523 CASE( 'weighted oce and ice' ) 524 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 525 IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl 492 526 CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE. 493 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_temperature' )527 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 494 528 END SELECT 495 529 … … 499 533 ssnd(jps_albice)%clname = 'O_AlbIce' 500 534 ssnd(jps_albmix)%clname = 'O_AlbMix' 501 SELECT CASE( TRIM( cn_snd_albedo) )535 SELECT CASE( TRIM( sn_snd_alb%cldes ) ) 502 536 CASE( 'none' ) ! nothing to do 503 537 CASE( 'weighted ice' ) ; ssnd(jps_albice)%laction = .TRUE. 504 538 CASE( 'mixed oce-ice' ) ; ssnd(jps_albmix)%laction = .TRUE. 505 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_albedo' )539 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' ) 506 540 END SELECT 507 541 ! … … 509 543 ! 1. sending mixed oce-ice albedo or 510 544 ! 2. receiving mixed oce-ice solar radiation 511 IF ( TRIM ( cn_snd_albedo ) == 'mixed oce-ice' .OR. TRIM ( cn_rcv_qsr) == 'mixed oce-ice' ) THEN545 IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 512 546 CALL albedo_oce( zaos, zacs ) 513 547 ! Due to lack of information on nebulosity : mean clear/overcast sky … … 518 552 ! ! Ice fraction & Thickness ! 519 553 ! ! ------------------------- ! 520 ssnd(jps_fice)%clname = 'OIceFrac' 521 ssnd(jps_hice)%clname = 'O_IceTck' 522 ssnd(jps_hsnw)%clname = 'O_SnwTck' 523 IF( k_ice /= 0 ) ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case) 524 IF( TRIM( cn_snd_thickness ) == 'weighted ice and snow' ) ssnd( (/jps_hice, jps_hsnw/) )%laction = .TRUE. 525 554 ssnd(jps_fice)%clname = 'OIceFrc' 555 ssnd(jps_hice)%clname = 'OIceTck' 556 ssnd(jps_hsnw)%clname = 'OSnwTck' 557 IF( k_ice /= 0 ) THEN 558 ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case) 559 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 560 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 561 ENDIF 562 563 SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 564 CASE ( 'ice and snow' ) 565 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 566 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 567 ssnd(jps_hice:jps_hsnw)%nct = jpl 568 ELSE 569 IF ( jpl > 1 ) THEN 570 CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' ) 571 ENDIF 572 ENDIF 573 CASE ( 'weighted ice and snow' ) 574 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 575 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = jpl 576 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 577 END SELECT 578 526 579 ! ! ------------------------- ! 527 580 ! ! Surface current ! … … 534 587 ssnd(jps_ocx1:jps_ivz1)%nsgn = -1. ! vectors: change of the sign at the north fold 535 588 536 IF( cn_snd_crt(4) /= 'T' ) CALL ctl_stop( 'cn_snd_crt(4) must be equal to T' ) 537 ssnd(jps_ocx1:jps_ivz1)%clgrid = 'T' ! all oce and ice components on the same unique grid 538 589 IF( sn_snd_crt%clvgrd == 'U,V' ) THEN 590 ssnd(jps_ocx1)%clgrid = 'U' ; ssnd(jps_ocy1)%clgrid = 'V' 591 ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN 592 CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' ) 593 ssnd(jps_ocx1:jps_ivz1)%clgrid = 'T' ! all oce and ice components on the same unique grid 594 ENDIF 539 595 ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE. ! default: all are send 540 IF( TRIM( cn_snd_crt(2) ) == 'spherical' ) ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE. 541 SELECT CASE( TRIM( cn_snd_crt(1) ) ) 596 IF( TRIM( sn_snd_crt%clvref ) == 'spherical' ) ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE. 597 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) ssnd(jps_ocx1:jps_ivz1)%nsgn = 1. 598 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 542 599 CASE( 'none' ) ; ssnd(jps_ocx1:jps_ivz1)%laction = .FALSE. 543 600 CASE( 'oce only' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 544 601 CASE( 'weighted oce and ice' ) ! nothing to do 545 602 CASE( 'mixed oce-ice' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 546 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_crt(1)' )603 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crt%cldes' ) 547 604 END SELECT 548 605 549 #if defined key_cpl_carbon_cycle550 606 ! ! ------------------------- ! 551 607 ! ! CO2 flux ! 552 608 ! ! ------------------------- ! 553 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(cn_snd_co2) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 554 #endif 609 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 555 610 ! 556 611 ! ================================ ! … … 636 691 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 637 692 DO jn = 1, jprcv ! received fields sent by the atmosphere 638 IF( srcv(jn)%laction ) CALL cpl_prism_rcv( jn, isec, frcv( :,:,jn), nrcvinfo(jn) )693 IF( srcv(jn)%laction ) CALL cpl_prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) ) 639 694 END DO 640 695 … … 642 697 IF( srcv(jpr_otx1)%laction ) THEN ! ocean stress components ! 643 698 ! ! ========================= ! 644 ! define frcv( :,:,jpr_otx1) and frcv(:,:,jpr_oty1): stress at U/V point along model grid699 ! define frcv(jpr_otx1)%z3(:,:,1) and frcv(jpr_oty1)%z3(:,:,1): stress at U/V point along model grid 645 700 ! => need to be done only when we receive the field 646 701 IF( nrcvinfo(jpr_otx1) == OASIS_Rcv ) THEN 647 702 ! 648 IF( TRIM( cn_rcv_tau(2)) == 'cartesian' ) THEN ! 2 components on the sphere703 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere 649 704 ! ! (cartesian to spherical -> 3 to 2 components) 650 705 ! 651 CALL geo2oce( frcv( :,:,jpr_otx1), frcv(:,:,jpr_oty1), frcv(:,:,jpr_otz1), &706 CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1), & 652 707 & srcv(jpr_otx1)%clgrid, ztx, zty ) 653 frcv( :,:,jpr_otx1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid654 frcv( :,:,jpr_oty1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid708 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid 709 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid 655 710 ! 656 711 IF( srcv(jpr_otx2)%laction ) THEN 657 CALL geo2oce( frcv( :,:,jpr_otx2), frcv(:,:,jpr_oty2), frcv(:,:,jpr_otz2), &712 CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1), & 658 713 & srcv(jpr_otx2)%clgrid, ztx, zty ) 659 frcv( :,:,jpr_otx2) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid660 frcv( :,:,jpr_oty2) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid714 frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid 715 frcv(jpr_oty2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid 661 716 ENDIF 662 717 ! 663 718 ENDIF 664 719 ! 665 IF( TRIM( cn_rcv_tau(3)) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid720 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 666 721 ! ! (geographical to local grid -> rotate the components) 667 CALL rot_rep( frcv( :,:,jpr_otx1), frcv(:,:,jpr_oty1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )668 frcv( :,:,jpr_otx1) = ztx(:,:) ! overwrite 1st component on the 1st grid722 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 723 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 669 724 IF( srcv(jpr_otx2)%laction ) THEN 670 CALL rot_rep( frcv( :,:,jpr_otx2), frcv(:,:,jpr_oty2), srcv(jpr_otx2)%clgrid, 'en->j', zty )671 ELSE 672 CALL rot_rep( frcv( :,:,jpr_otx1), frcv(:,:,jpr_oty1), srcv(jpr_otx1)%clgrid, 'en->j', zty )725 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 726 ELSE 727 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 673 728 ENDIF 674 frcv( :,:,jpr_oty1) = zty(:,:) ! overwrite 2nd component on the 2nd grid729 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 675 730 ENDIF 676 731 ! … … 678 733 DO jj = 2, jpjm1 ! T ==> (U,V) 679 734 DO ji = fs_2, fs_jpim1 ! vector opt. 680 frcv(j i,jj,jpr_otx1) = 0.5 * ( frcv(ji+1,jj ,jpr_otx1) + frcv(ji,jj,jpr_otx1) )681 frcv(j i,jj,jpr_oty1) = 0.5 * ( frcv(ji ,jj+1,jpr_oty1) + frcv(ji,jj,jpr_oty1) )735 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 736 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 682 737 END DO 683 738 END DO 684 CALL lbc_lnk( frcv( :,:,jpr_otx1), 'U', -1. ) ; CALL lbc_lnk( frcv(:,:,jpr_oty1), 'V', -1. )739 CALL lbc_lnk( frcv(jpr_otx1)%z3(:,:,1), 'U', -1. ) ; CALL lbc_lnk( frcv(jpr_oty1)%z3(:,:,1), 'V', -1. ) 685 740 ENDIF 686 741 llnewtx = .TRUE. … … 691 746 ELSE ! No dynamical coupling ! 692 747 ! ! ========================= ! 693 frcv( :,:,jpr_otx1) = 0.e0 ! here simply set to zero694 frcv( :,:,jpr_oty1) = 0.e0 ! an external read in a file can be added instead748 frcv(jpr_otx1)%z3(:,:,1) = 0.e0 ! here simply set to zero 749 frcv(jpr_oty1)%z3(:,:,1) = 0.e0 ! an external read in a file can be added instead 695 750 llnewtx = .TRUE. 696 751 ! … … 708 763 !CDIR NOVERRCHK 709 764 DO ji = fs_2, fs_jpim1 ! vect. opt. 710 zzx = frcv(j i-1,jj ,jpr_otx1) + frcv(ji,jj,jpr_otx1)711 zzy = frcv(j i ,jj-1,jpr_oty1) + frcv(ji,jj,jpr_oty1)712 frcv(j i,jj,jpr_taum) = 0.5 * SQRT( zzx * zzx + zzy * zzy )765 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 766 zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) 767 frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 713 768 END DO 714 769 END DO 715 CALL lbc_lnk( frcv( :,:,jpr_taum), 'T', 1. )770 CALL lbc_lnk( frcv(jpr_taum)%z3(:,:,1), 'T', 1. ) 716 771 llnewtau = .TRUE. 717 772 ELSE … … 722 777 ! Stress module can be negative when received (interpolation problem) 723 778 IF( llnewtau ) THEN 724 DO jj = 1, jpj 725 DO ji = 1, jpi 726 frcv(ji,jj,jpr_taum) = MAX( 0.0e0, frcv(ji,jj,jpr_taum) ) 727 END DO 728 END DO 779 frcv(jpr_taum)%z3(:,:,1) = MAX( 0.0e0, frcv(jpr_taum)%z3(:,:,1) ) 729 780 ENDIF 730 781 ENDIF … … 742 793 !CDIR NOVERRCHK 743 794 DO ji = 1, jpi 744 frcv(ji,jj,jpr_w10m) = SQRT( frcv(ji,jj,jpr_taum) * zcoef )795 wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 745 796 END DO 746 797 END DO 747 798 ENDIF 748 ENDIF 749 750 ! u(v)tau and taum will be modified by ice model (wndm will be changed by PISCES) 799 ELSE 800 IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 801 ENDIF 802 803 ! u(v)tau and taum will be modified by ice model 751 804 ! -> need to be reset before each call of the ice/fsbc 752 805 IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 753 806 ! 754 utau(:,:) = frcv(:,:,jpr_otx1) 755 vtau(:,:) = frcv(:,:,jpr_oty1) 756 taum(:,:) = frcv(:,:,jpr_taum) 757 wndm(:,:) = frcv(:,:,jpr_w10m) 807 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 808 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 809 taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 758 810 CALL iom_put( "taum_oce", taum ) ! output wind stress module 759 811 ! 760 812 ENDIF 813 814 #if defined key_cpl_carbon_cycle 815 ! ! atmosph. CO2 (ppm) 816 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 817 #endif 818 761 819 ! ! ========================= ! 762 820 IF( k_ice <= 1 ) THEN ! heat & freshwater fluxes ! (Ocean only case) … … 764 822 ! 765 823 ! ! non solar heat flux over the ocean (qns) 766 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv( :,:,jpr_qnsoce)767 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv( :,:,jpr_qnsmix)824 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 825 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 768 826 ! add the latent heat of solid precip. melting 769 IF( srcv(jpr_snow )%laction ) qns(:,:) = qns(:,:) - frcv( :,:,jpr_snow) * lfus827 IF( srcv(jpr_snow )%laction ) qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus 770 828 771 829 ! ! solar flux over the ocean (qsr) 772 IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv( :,:,jpr_qsroce)773 IF( srcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv( :,:,jpr_qsrmix)830 IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 831 IF( srcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 774 832 IF( ln_dm2dc ) qsr(:,:) = sbc_dcy( qsr ) ! modify qsr to include the diurnal cycle 775 833 ! 776 834 ! ! total freshwater fluxes over the ocean (emp, emps) 777 SELECT CASE( TRIM( cn_rcv_emp) ) ! evaporation - precipitation835 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 778 836 CASE( 'conservative' ) 779 emp(:,:) = frcv( :,:,jpr_tevp) - ( frcv(:,:,jpr_rain) + frcv(:,:,jpr_snow) )837 emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 780 838 CASE( 'oce only', 'oce and ice' ) 781 emp(:,:) = frcv( :,:,jpr_oemp)839 emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 782 840 CASE default 783 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of cn_rcv_emp' )841 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 784 842 END SELECT 785 843 ! 786 844 ! ! runoffs and calving (added in emp) 787 IF( srcv(jpr_rnf)%laction ) emp(:,:) = emp(:,:) - frcv( :,:,jpr_rnf)788 IF( srcv(jpr_cal)%laction ) emp(:,:) = emp(:,:) - frcv( :,:,jpr_cal)845 IF( srcv(jpr_rnf)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 846 IF( srcv(jpr_cal)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 789 847 ! 790 848 !!gm : this seems to be internal cooking, not sure to need that in a generic interface 791 849 !!gm at least should be optional... 792 !! IF( TRIM( cn_rcv_rnf) == 'coupled' ) THEN ! add to the total freshwater budget850 !! IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN ! add to the total freshwater budget 793 851 !! ! remove negative runoff 794 !! zcumulpos = SUM( MAX( frcv( :,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )795 !! zcumulneg = SUM( MIN( frcv( :,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )852 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 853 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 796 854 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) ! sum over the global domain 797 855 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 798 856 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 799 857 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 800 !! frcv( :,:,jpr_rnf) = MAX( frcv(:,:,jpr_rnf), 0.e0 ) * zcumulneg858 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 801 859 !! ENDIF 802 860 !! ! add runoff to e-p 803 !! emp(:,:) = emp(:,:) - frcv( :,:,jpr_rnf)861 !! emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 804 862 !! ENDIF 805 863 !!gm end of internal cooking … … 807 865 emps(:,:) = emp(:,:) ! concentration/dilution = emp 808 866 809 ! ! 10 m wind speed810 IF( srcv(jpr_w10m)%laction ) wndm(:,:) = frcv(:,:,jpr_w10m)811 !812 #if defined key_cpl_carbon_cycle813 ! ! atmosph. CO2 (ppm)814 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(:,:,jpr_co2)815 #endif816 817 867 ENDIF 818 868 ! … … 880 930 ! ! ======================= ! 881 931 ! 882 IF( TRIM( cn_rcv_tau(2)) == 'cartesian' ) THEN ! 2 components on the sphere932 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere 883 933 ! ! (cartesian to spherical -> 3 to 2 components) 884 CALL geo2oce( frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1), frcv(:,:,jpr_itz1), &934 CALL geo2oce( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1), & 885 935 & srcv(jpr_itx1)%clgrid, ztx, zty ) 886 frcv( :,:,jpr_itx1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid887 frcv( :,:,jpr_itx1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid936 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid 937 frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid 888 938 ! 889 939 IF( srcv(jpr_itx2)%laction ) THEN 890 CALL geo2oce( frcv( :,:,jpr_itx2), frcv(:,:,jpr_ity2), frcv(:,:,jpr_itz2), &940 CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1), & 891 941 & srcv(jpr_itx2)%clgrid, ztx, zty ) 892 frcv( :,:,jpr_itx2) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid893 frcv( :,:,jpr_ity2) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid942 frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid 943 frcv(jpr_ity2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid 894 944 ENDIF 895 945 ! 896 946 ENDIF 897 947 ! 898 IF( TRIM( cn_rcv_tau(3)) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid948 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 899 949 ! ! (geographical to local grid -> rotate the components) 900 CALL rot_rep( frcv( :,:,jpr_itx1), frcv(:,:,jpr_ity1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )901 frcv( :,:,jpr_itx1) = ztx(:,:) ! overwrite 1st component on the 1st grid950 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx ) 951 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 902 952 IF( srcv(jpr_itx2)%laction ) THEN 903 CALL rot_rep( frcv( :,:,jpr_itx2), frcv(:,:,jpr_ity2), srcv(jpr_itx2)%clgrid, 'en->j', zty )953 CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty ) 904 954 ELSE 905 CALL rot_rep( frcv( :,:,jpr_itx1), frcv(:,:,jpr_ity1), srcv(jpr_itx1)%clgrid, 'en->j', zty )955 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty ) 906 956 ENDIF 907 frcv( :,:,jpr_ity1) = zty(:,:) ! overwrite 2nd component on the 1st grid957 frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid 908 958 ENDIF 909 959 ! ! ======================= ! 910 960 ELSE ! use ocean stress ! 911 961 ! ! ======================= ! 912 frcv( :,:,jpr_itx1) = frcv(:,:,jpr_otx1)913 frcv( :,:,jpr_ity1) = frcv(:,:,jpr_oty1)962 frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1) 963 frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1) 914 964 ! 915 965 ENDIF … … 934 984 DO jj = 2, jpjm1 ! (U,V) ==> I 935 985 DO ji = 2, jpim1 ! NO vector opt. 936 p_taui(ji,jj) = 0.5 * ( frcv(j i-1,jj ,jpr_itx1) + frcv(ji-1,jj-1,jpr_itx1) )937 p_tauj(ji,jj) = 0.5 * ( frcv(j i ,jj-1,jpr_ity1) + frcv(ji-1,jj-1,jpr_ity1) )986 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji-1,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) ) 987 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) ) 938 988 END DO 939 989 END DO … … 941 991 DO jj = 2, jpjm1 ! F ==> I 942 992 DO ji = 2, jpim1 ! NO vector opt. 943 p_taui(ji,jj) = frcv(j i-1,jj-1,jpr_itx1)944 p_tauj(ji,jj) = frcv(j i-1,jj-1,jpr_ity1)993 p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji-1,jj-1,1) 994 p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji-1,jj-1,1) 945 995 END DO 946 996 END DO … … 948 998 DO jj = 2, jpjm1 ! T ==> I 949 999 DO ji = 2, jpim1 ! NO vector opt. 950 p_taui(ji,jj) = 0.25 * ( frcv(j i,jj ,jpr_itx1) + frcv(ji-1,jj ,jpr_itx1) &951 & + frcv(j i,jj-1,jpr_itx1) + frcv(ji-1,jj-1,jpr_itx1) )952 p_tauj(ji,jj) = 0.25 * ( frcv(j i,jj ,jpr_ity1) + frcv(ji-1,jj ,jpr_ity1) &953 & + frcv(j i,jj-1,jpr_ity1) + frcv(ji-1,jj-1,jpr_ity1) )1000 p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj ,1) & 1001 & + frcv(jpr_itx1)%z3(ji,jj-1,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) ) 1002 p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) & 1003 & + frcv(jpr_oty1)%z3(ji,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) ) 954 1004 END DO 955 1005 END DO 956 1006 CASE( 'I' ) 957 p_taui(:,:) = frcv( :,:,jpr_itx1) ! I ==> I958 p_tauj(:,:) = frcv( :,:,jpr_ity1)1007 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! I ==> I 1008 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 959 1009 END SELECT 960 1010 IF( srcv(jpr_itx1)%clgrid /= 'I' ) THEN … … 967 1017 DO jj = 2, jpjm1 ! (U,V) ==> F 968 1018 DO ji = fs_2, fs_jpim1 ! vector opt. 969 p_taui(ji,jj) = 0.5 * ( frcv(j i,jj,jpr_itx1) + frcv(ji ,jj+1,jpr_itx1) )970 p_tauj(ji,jj) = 0.5 * ( frcv(j i,jj,jpr_ity1) + frcv(ji+1,jj ,jpr_ity1) )1019 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj+1,1) ) 1020 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) ) 971 1021 END DO 972 1022 END DO … … 974 1024 DO jj = 2, jpjm1 ! I ==> F 975 1025 DO ji = 2, jpim1 ! NO vector opt. 976 p_taui(ji,jj) = frcv(j i+1,jj+1,jpr_itx1)977 p_tauj(ji,jj) = frcv(j i+1,jj+1,jpr_ity1)1026 p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji+1,jj+1,1) 1027 p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji+1,jj+1,1) 978 1028 END DO 979 1029 END DO … … 981 1031 DO jj = 2, jpjm1 ! T ==> F 982 1032 DO ji = 2, jpim1 ! NO vector opt. 983 p_taui(ji,jj) = 0.25 * ( frcv(j i,jj ,jpr_itx1) + frcv(ji+1,jj ,jpr_itx1) &984 & + frcv(j i,jj+1,jpr_itx1) + frcv(ji+1,jj+1,jpr_itx1) )985 p_tauj(ji,jj) = 0.25 * ( frcv(j i,jj ,jpr_ity1) + frcv(ji+1,jj ,jpr_ity1) &986 & + frcv(j i,jj+1,jpr_ity1) + frcv(ji+1,jj+1,jpr_ity1) )1033 p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) & 1034 & + frcv(jpr_itx1)%z3(ji,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj+1,1) ) 1035 p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) & 1036 & + frcv(jpr_ity1)%z3(ji,jj+1,1) + frcv(jpr_ity1)%z3(ji+1,jj+1,1) ) 987 1037 END DO 988 1038 END DO 989 1039 CASE( 'F' ) 990 p_taui(:,:) = frcv( :,:,jpr_itx1) ! F ==> F991 p_tauj(:,:) = frcv( :,:,jpr_ity1)1040 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! F ==> F 1041 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 992 1042 END SELECT 993 1043 IF( srcv(jpr_itx1)%clgrid /= 'F' ) THEN … … 998 1048 SELECT CASE ( srcv(jpr_itx1)%clgrid ) 999 1049 CASE( 'U' ) 1000 p_taui(:,:) = frcv( :,:,jpr_itx1) ! (U,V) ==> (U,V)1001 p_tauj(:,:) = frcv( :,:,jpr_ity1)1050 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! (U,V) ==> (U,V) 1051 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 1002 1052 CASE( 'F' ) 1003 1053 DO jj = 2, jpjm1 ! F ==> (U,V) 1004 1054 DO ji = fs_2, fs_jpim1 ! vector opt. 1005 p_taui(ji,jj) = 0.5 * ( frcv(j i,jj,jpr_itx1) + frcv(ji ,jj-1,jpr_itx1) )1006 p_tauj(ji,jj) = 0.5 * ( frcv(j i,jj,jpr_ity1) + frcv(ji-1,jj ,jpr_ity1) )1055 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj-1,1) ) 1056 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(jj,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) ) 1007 1057 END DO 1008 1058 END DO … … 1010 1060 DO jj = 2, jpjm1 ! T ==> (U,V) 1011 1061 DO ji = fs_2, fs_jpim1 ! vector opt. 1012 p_taui(ji,jj) = 0.5 * ( frcv(j i+1,jj ,jpr_itx1) + frcv(ji,jj,jpr_itx1) )1013 p_tauj(ji,jj) = 0.5 * ( frcv(j i ,jj+1,jpr_ity1) + frcv(ji,jj,jpr_ity1) )1062 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 1063 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1014 1064 END DO 1015 1065 END DO … … 1017 1067 DO jj = 2, jpjm1 ! I ==> (U,V) 1018 1068 DO ji = 2, jpim1 ! NO vector opt. 1019 p_taui(ji,jj) = 0.5 * ( frcv(j i+1,jj+1,jpr_itx1) + frcv(ji+1,jj ,jpr_itx1) )1020 p_tauj(ji,jj) = 0.5 * ( frcv(j i+1,jj+1,jpr_ity1) + frcv(ji ,jj+1,jpr_ity1) )1069 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) ) 1070 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji ,jj+1,1) ) 1021 1071 END DO 1022 1072 END DO … … 1027 1077 END SELECT 1028 1078 1029 !!gm Should be useless as sbc_cpl_ice_tau only called at coupled frequency1030 ! The receive stress are transformed such that in all case frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1)1031 ! become the i-component and j-component of the stress at the right grid point1032 !!gm frcv(:,:,jpr_itx1) = p_taui(:,:)1033 !!gm frcv(:,:,jpr_ity1) = p_tauj(:,:)1034 !!gm1035 1079 ENDIF 1036 1080 ! … … 1040 1084 1041 1085 1042 SUBROUTINE sbc_cpl_ice_flx( p_frld , & 1043 & pqns_tot, pqns_ice, pqsr_tot , pqsr_ice, & 1044 & pemp_tot, pemp_ice, pdqns_ice, psprecip, & 1045 & palbi , psst , pist ) 1086 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist ) 1046 1087 !!---------------------------------------------------------------------- 1047 !! *** ROUTINE sbc_cpl_ice_flx _rcv***1088 !! *** ROUTINE sbc_cpl_ice_flx *** 1048 1089 !! 1049 1090 !! ** Purpose : provide the heat and freshwater fluxes of the … … 1066 1107 !! the atmosphere 1067 1108 !! 1068 !! N.B. - fields over sea-ice are passed in argument so that1069 !! the module can be compile without sea-ice.1070 1109 !! - the fluxes have been separated from the stress as 1071 1110 !! (a) they are updated at each ice time step compare to … … 1078 1117 !! 1079 1118 !! ** Action : update at each nf_ice time step: 1080 !! pqns_tot, pqsr_tot non-solar and solar total heat fluxes1081 !! pqns_ice, pqsr_ice non-solar and solar heat fluxes over the ice1082 !! pemp_tot total evaporation - precipitation(liquid and solid) (-runoff)(-calving)1083 !! pemp_ice ice sublimation - solid precipitation over the ice1084 !! pdqns_ice d(non-solar heat flux)/d(Temperature) over the ice1119 !! qns_tot, qsr_tot non-solar and solar total heat fluxes 1120 !! qns_ice, qsr_ice non-solar and solar heat fluxes over the ice 1121 !! emp_tot total evaporation - precipitation(liquid and solid) (-runoff)(-calving) 1122 !! emp_ice ice sublimation - solid precipitation over the ice 1123 !! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice 1085 1124 !! sprecip solid precipitation over the ocean 1086 1125 !!---------------------------------------------------------------------- 1087 1126 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 1088 USE wrk_nemo, ONLY: zcptn => wrk_2d_1 ! rcp * tsn(:,:,1,jp_tem) 1089 USE wrk_nemo, ONLY: ztmp => wrk_2d_2 ! temporary array 1090 USE wrk_nemo, ONLY: zsnow => wrk_2d_3 ! snow precipitation 1091 USE wrk_nemo, ONLY: zicefr => wrk_3d_4 ! ice fraction 1092 !! 1093 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: p_frld ! lead fraction [0 to 1] 1094 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqns_tot ! total non solar heat flux [W/m2] 1095 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqns_ice ! ice non solar heat flux [W/m2] 1096 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqsr_tot ! total solar heat flux [W/m2] 1097 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqsr_ice ! ice solar heat flux [W/m2] 1098 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_tot ! total freshwater budget [Kg/m2/s] 1099 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_ice ! solid freshwater budget over ice [Kg/m2/s] 1100 REAL(wp), INTENT( out), DIMENSION(:,: ) :: psprecip ! Net solid precipitation (=emp_ice) [Kg/m2/s] 1101 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pdqns_ice ! d(Q non solar)/d(Temperature) over ice 1127 USE wrk_nemo, ONLY: zcptn => wrk_2d_2 ! rcp * tsn(:,:,1,jp_tem) 1128 USE wrk_nemo, ONLY: ztmp => wrk_2d_3 ! temporary array 1129 USE wrk_nemo, ONLY: zicefr => wrk_2d_4 ! ice fraction 1130 !! 1131 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1102 1132 ! optional arguments, used only in 'mixed oce-ice' case 1103 1133 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! ice albedo 1104 1134 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celcius] 1105 1135 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1106 !! 1107 INTEGER :: ji, jj ! dummy loop indices 1108 INTEGER :: isec, info ! temporary integer 1109 REAL(wp):: zcoef, ztsurf ! temporary scalar 1136 ! 1137 INTEGER :: jl ! dummy loop index 1110 1138 !!---------------------------------------------------------------------- 1111 1139 1112 IF( wrk_in_use(2, 1,2,3) .OR. wrk_in_use(3,4) ) THEN1140 IF( wrk_in_use(2, 2,3,4) ) THEN 1113 1141 CALL ctl_stop('sbc_cpl_ice_flx: requested workspace arrays unavailable') ; RETURN 1114 1142 ENDIF 1115 1143 1116 zicefr(:,: ,1) = 1.- p_frld(:,:,1)1144 zicefr(:,:) = 1.- p_frld(:,:) 1117 1145 IF( lk_diaar5 ) zcptn(:,:) = rcp * tsn(:,:,1,jp_tem) 1118 1146 ! … … 1124 1152 ! ! solid precipitation - sublimation (emp_ice) 1125 1153 ! ! solid Precipitation (sprecip) 1126 SELECT CASE( TRIM( cn_rcv_emp) )1154 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1127 1155 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1128 pemp_tot(:,:) = frcv(:,:,jpr_tevp) - frcv(:,:,jpr_rain) - frcv(:,:,jpr_snow) 1129 pemp_ice(:,:) = frcv(:,:,jpr_ievp) - frcv(:,:,jpr_snow) 1130 zsnow (:,:) = frcv(:,:,jpr_snow) 1131 CALL iom_put( 'rain' , frcv(:,:,jpr_rain) ) ! liquid precipitation 1132 IF( lk_diaar5 ) CALL iom_put( 'hflx_rain_cea', frcv(:,:,jpr_rain) * zcptn(:,:) ) ! heat flux from liq. precip. 1133 ztmp(:,:) = frcv(:,:,jpr_tevp) - frcv(:,:,jpr_ievp) * zicefr(:,:,1) 1156 sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1157 tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here 1158 emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 1159 emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1160 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1161 IF( lk_diaar5 ) CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1162 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1134 1163 CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average) 1135 1164 IF( lk_diaar5 ) CALL iom_put( 'hflx_evap_cea', ztmp(:,: ) * zcptn(:,:) ) ! heat flux from from evap (cell ave) 1136 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp 1137 pemp_tot(:,:) = p_frld(:,:,1) * frcv(:,:,jpr_oemp) + zicefr(:,:,1) * frcv(:,:,jpr_sbpr)1138 pemp_ice(:,:) = frcv(:,:,jpr_semp)1139 zsnow (:,:) = - frcv(:,:,jpr_semp) + frcv(:,:,jpr_ievp)1165 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1166 emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1167 emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1168 sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 1140 1169 END SELECT 1141 psprecip(:,:) = - pemp_ice(:,:) 1142 CALL iom_put( 'snowpre' , zsnow) ! Snow1143 CALL iom_put( 'snow_ao_cea', zsnow(:,: ) * p_frld(:,:,1)) ! Snow over ice-free ocean (cell average)1144 CALL iom_put( 'snow_ai_cea', zsnow(:,: ) * zicefr(:,:,1)) ! Snow over sea-ice (cell average)1145 CALL iom_put( 'subl_ai_cea', frcv (:,:,jpr_ievp) * zicefr(:,:,1) ) ! Sublimation over sea-ice (cell average)1170 1171 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1172 CALL iom_put( 'snow_ao_cea', sprecip(:,: ) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1173 CALL iom_put( 'snow_ai_cea', sprecip(:,: ) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1174 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1146 1175 ! 1147 1176 ! ! runoffs and calving (put in emp_tot) 1148 1177 IF( srcv(jpr_rnf)%laction ) THEN 1149 pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_rnf)1150 CALL iom_put( 'runoffs' , frcv( :,:,jpr_rnf) ) ! rivers1151 IF( lk_diaar5 ) CALL iom_put( 'hflx_rnf_cea' , frcv( :,:,jpr_rnf) * zcptn(:,:) ) ! heat flux from rivers1178 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 1179 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers 1180 IF( lk_diaar5 ) CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers 1152 1181 ENDIF 1153 1182 IF( srcv(jpr_cal)%laction ) THEN 1154 pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_cal)1155 CALL iom_put( 'calving', frcv( :,:,jpr_cal) )1183 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1184 CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) ) 1156 1185 ENDIF 1157 1186 ! … … 1159 1188 !!gm at least should be optional... 1160 1189 !! ! remove negative runoff ! sum over the global domain 1161 !! zcumulpos = SUM( MAX( frcv( :,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1162 !! zcumulneg = SUM( MIN( frcv( :,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1190 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 1191 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 1163 1192 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) 1164 1193 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 1165 1194 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 1166 1195 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 1167 !! frcv( :,:,jpr_rnf) = MAX( frcv(:,:,jpr_rnf), 0.e0 ) * zcumulneg1196 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 1168 1197 !! ENDIF 1169 !! pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_rnf) ! add runoff to e-p1198 !! emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) ! add runoff to e-p 1170 1199 !! 1171 1200 !!gm end of internal cooking 1172 1201 1173 1174 1202 ! ! ========================= ! 1175 SELECT CASE( TRIM( cn_rcv_qns ) )! non solar heat fluxes ! (qns)1203 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns) 1176 1204 ! ! ========================= ! 1205 CASE( 'oce only' ) ! the required field is directly provided 1206 qns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1) 1177 1207 CASE( 'conservative' ) ! the required fields are directly provided 1178 pqns_tot(:,: ) = frcv(:,:,jpr_qnsmix) 1179 pqns_ice(:,:,1) = frcv(:,:,jpr_qnsice) 1208 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1209 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1210 qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1211 ELSE 1212 ! Set all category values equal for the moment 1213 DO jl=1,jpl 1214 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1215 ENDDO 1216 ENDIF 1180 1217 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1181 pqns_tot(:,: ) = p_frld(:,:,1) * frcv(:,:,jpr_qnsoce) + zicefr(:,:,1) * frcv(:,:,jpr_qnsice) 1182 pqns_ice(:,:,1) = frcv(:,:,jpr_qnsice) 1218 qns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1219 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1220 DO jl=1,jpl 1221 qns_tot(:,: ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) 1222 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 1223 ENDDO 1224 ELSE 1225 DO jl=1,jpl 1226 qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1227 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1228 ENDDO 1229 ENDIF 1183 1230 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1184 pqns_tot(:,: ) = frcv(:,:,jpr_qnsmix) 1185 pqns_ice(:,:,1) = frcv(:,:,jpr_qnsmix) & 1186 & + frcv(:,:,jpr_dqnsdt) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:,1) & 1187 & + pist(:,:,1) * zicefr(:,:,1) ) ) 1231 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1232 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1233 qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1234 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1235 & + pist(:,:,1) * zicefr(:,:) ) ) 1188 1236 END SELECT 1189 ztmp(:,:) = p_frld(:,: ,1) * zsnow(:,:) * lfus ! add the latent heat of solid precip. melting1190 pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:)! over free ocean1191 IF( lk_diaar5 ) CALL iom_put( 'hflx_snow_cea', ztmp + zsnow(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average)1237 ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus ! add the latent heat of solid precip. melting 1238 qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) ! over free ocean 1239 IF( lk_diaar5 ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1192 1240 !!gm 1193 1241 !! currently it is taken into account in leads budget but not in the qns_tot, and thus not in … … 1199 1247 ! 1200 1248 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1201 ztmp(:,:) = frcv( :,:,jpr_cal) * lfus! add the latent heat of iceberg melting1202 pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:)1203 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + frcv( :,:,jpr_cal) * zcptn(:,:) ) ! heat flux from calving1249 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1250 qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 1251 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1204 1252 ENDIF 1205 1253 1206 1254 ! ! ========================= ! 1207 SELECT CASE( TRIM( cn_rcv_qsr ) )! solar heat fluxes ! (qsr)1255 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr) 1208 1256 ! ! ========================= ! 1257 CASE( 'oce only' ) 1258 qsr_tot(:,: ) = MAX(0.0,frcv(jpr_qsroce)%z3(:,:,1)) 1209 1259 CASE( 'conservative' ) 1210 pqsr_tot(:,: ) = frcv(:,:,jpr_qsrmix) 1211 pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrice) 1260 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1261 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1262 qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 1263 ELSE 1264 ! Set all category values equal for the moment 1265 DO jl=1,jpl 1266 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1267 ENDDO 1268 ENDIF 1269 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1270 qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1212 1271 CASE( 'oce and ice' ) 1213 pqsr_tot(:,: ) = p_frld(:,:,1) * frcv(:,:,jpr_qsroce) + zicefr(:,:,1) * frcv(:,:,jpr_qsrice) 1214 pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrice) 1272 qsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1273 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1274 DO jl=1,jpl 1275 qsr_tot(:,: ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) 1276 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 1277 ENDDO 1278 ELSE 1279 DO jl=1,jpl 1280 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1281 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1282 ENDDO 1283 ENDIF 1215 1284 CASE( 'mixed oce-ice' ) 1216 pqsr_tot(:,: ) = frcv(:,:,jpr_qsrmix) 1285 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1286 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1217 1287 ! Create solar heat flux over ice using incoming solar heat flux and albedos 1218 1288 ! ( see OASIS3 user guide, 5th edition, p39 ) 1219 pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrmix) * ( 1.- palbi(:,:,1) ) &1220 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,: ,1)&1221 & + palbi (:,:,1) * zicefr(:,: ,1) ) )1289 qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1290 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) & 1291 & + palbi (:,:,1) * zicefr(:,:) ) ) 1222 1292 END SELECT 1223 1293 IF( ln_dm2dc ) THEN ! modify qsr to include the diurnal cycle 1224 pqsr_tot(:,: ) = sbc_dcy( pqsr_tot(:,: ) ) 1225 pqsr_ice(:,:,1) = sbc_dcy( pqsr_ice(:,:,1) ) 1226 ENDIF 1227 1228 SELECT CASE( TRIM( cn_rcv_dqnsdt ) ) 1294 qsr_tot(:,: ) = sbc_dcy( qsr_tot(:,: ) ) 1295 DO jl=1,jpl 1296 qsr_ice(:,:,jl) = sbc_dcy( qsr_ice(:,:,jl) ) 1297 ENDDO 1298 ENDIF 1299 1300 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 1229 1301 CASE ('coupled') 1230 pdqns_ice(:,:,1) = frcv(:,:,jpr_dqnsdt) 1302 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 1303 dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 1304 ELSE 1305 ! Set all category values equal for the moment 1306 DO jl=1,jpl 1307 dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 1308 ENDDO 1309 ENDIF 1231 1310 END SELECT 1232 1311 1233 IF( wrk_not_released(2, 1,2,3) .OR. & 1234 wrk_not_released(3, 4) ) CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays') 1312 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 1313 CASE ('coupled') 1314 topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) 1315 botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:) 1316 END SELECT 1317 1318 IF( wrk_not_released(2, 2,3,4) ) CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays') 1235 1319 ! 1236 1320 END SUBROUTINE sbc_cpl_ice_flx … … 1249 1333 USE wrk_nemo, ONLY: zfr_l => wrk_2d_1 ! 1. - fr_i(:,:) 1250 1334 USE wrk_nemo, ONLY: ztmp1 => wrk_2d_2 , ztmp2 => wrk_2d_3 1335 USE wrk_nemo, ONLY: ztmp3 => wrk_3d_1 , ztmp4 => wrk_3d_2 1251 1336 USE wrk_nemo, ONLY: zotx1 => wrk_2d_4 , zoty1 => wrk_2d_5 , zotz1 => wrk_2d_6 1252 1337 USE wrk_nemo, ONLY: zitx1 => wrk_2d_7 , zity1 => wrk_2d_8 , zitz1 => wrk_2d_9 … … 1254 1339 INTEGER, INTENT(in) :: kt 1255 1340 ! 1256 INTEGER :: ji, jj 1341 INTEGER :: ji, jj, jl ! dummy loop indices 1257 1342 INTEGER :: isec, info ! local integer 1258 1343 !!---------------------------------------------------------------------- 1259 1344 1260 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9) ) THEN1345 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9) .OR. wrk_in_use(3, 1,2) ) THEN 1261 1346 CALL ctl_stop('sbc_cpl_snd: requested workspace arrays are unavailable') ; RETURN 1262 1347 ENDIF … … 1269 1354 ! ! Surface temperature ! in Kelvin 1270 1355 ! ! ------------------------- ! 1271 SELECT CASE( cn_snd_temperature)1356 SELECT CASE( sn_snd_temp%cldes) 1272 1357 CASE( 'oce only' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 1273 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1274 ztmp2(:,:) = tn_ice(:,:,1) * fr_i(:,:) 1275 CASE( 'mixed oce-ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) + tn_ice(:,:,1) * fr_i(:,:) 1276 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of cn_snd_temperature' ) 1358 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1359 SELECT CASE( sn_snd_temp%clcat ) 1360 CASE( 'yes' ) 1361 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1362 CASE( 'no' ) 1363 ztmp3(:,:,:) = 0.0 1364 DO jl=1,jpl 1365 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 1366 ENDDO 1367 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1368 END SELECT 1369 CASE( 'mixed oce-ice' ) 1370 ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:) 1371 DO jl=1,jpl 1372 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1373 ENDDO 1374 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1277 1375 END SELECT 1278 IF( ssnd(jps_toce)%laction ) CALL cpl_prism_snd( jps_toce, isec, ztmp1, info )1279 IF( ssnd(jps_tice)%laction ) CALL cpl_prism_snd( jps_tice, isec, ztmp 2, info )1280 IF( ssnd(jps_tmix)%laction ) CALL cpl_prism_snd( jps_tmix, isec, ztmp1, info )1376 IF( ssnd(jps_toce)%laction ) CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1377 IF( ssnd(jps_tice)%laction ) CALL cpl_prism_snd( jps_tice, isec, ztmp3, info ) 1378 IF( ssnd(jps_tmix)%laction ) CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1281 1379 ! 1282 1380 ! ! ------------------------- ! … … 1284 1382 ! ! ------------------------- ! 1285 1383 IF( ssnd(jps_albice)%laction ) THEN ! ice 1286 ztmp 1(:,:) = alb_ice(:,:,1) * fr_i(:,:)1287 CALL cpl_prism_snd( jps_albice, isec, ztmp 1, info )1384 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1385 CALL cpl_prism_snd( jps_albice, isec, ztmp3, info ) 1288 1386 ENDIF 1289 1387 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean 1290 ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) + alb_ice(:,:,1) * fr_i(:,:) 1291 CALL cpl_prism_snd( jps_albmix, isec, ztmp1, info ) 1388 ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) 1389 DO jl=1,jpl 1390 ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 1391 ENDDO 1392 CALL cpl_prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1292 1393 ENDIF 1293 1394 ! ! ------------------------- ! 1294 1395 ! ! Ice fraction & Thickness ! 1295 1396 ! ! ------------------------- ! 1296 IF( ssnd(jps_fice)%laction ) CALL cpl_prism_snd( jps_fice, isec, fr_i , info ) 1297 IF( ssnd(jps_hice)%laction ) CALL cpl_prism_snd( jps_hice, isec, hicif(:,:) * fr_i(:,:), info ) 1298 IF( ssnd(jps_hsnw)%laction ) CALL cpl_prism_snd( jps_hsnw, isec, hsnif(:,:) * fr_i(:,:), info ) 1397 ! Send ice fraction field 1398 SELECT CASE( sn_snd_thick%clcat ) 1399 CASE( 'yes' ) 1400 ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl) 1401 CASE( 'no' ) 1402 ztmp3(:,:,1) = fr_i(:,:) 1403 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1404 END SELECT 1405 IF( ssnd(jps_fice)%laction ) CALL cpl_prism_snd( jps_fice, isec, ztmp3, info ) 1406 1407 ! Send ice and snow thickness field 1408 SELECT CASE( sn_snd_thick%cldes) 1409 CASE( 'weighted ice and snow' ) 1410 SELECT CASE( sn_snd_thick%clcat ) 1411 CASE( 'yes' ) 1412 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) * a_i(:,:,1:jpl) 1413 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) * a_i(:,:,1:jpl) 1414 CASE( 'no' ) 1415 ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0 1416 DO jl=1,jpl 1417 ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl) 1418 ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl) 1419 ENDDO 1420 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1421 END SELECT 1422 CASE( 'ice and snow' ) 1423 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 1424 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 1425 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 1426 END SELECT 1427 IF( ssnd(jps_hice)%laction ) CALL cpl_prism_snd( jps_hice, isec, ztmp3, info ) 1428 IF( ssnd(jps_hsnw)%laction ) CALL cpl_prism_snd( jps_hsnw, isec, ztmp4, info ) 1299 1429 ! 1300 1430 #if defined key_cpl_carbon_cycle … … 1302 1432 ! ! CO2 flux from PISCES ! 1303 1433 ! ! ------------------------- ! 1304 IF( ssnd(jps_co2)%laction ) CALL cpl_prism_snd( jps_co2, isec, oce_co2, info )1434 IF( ssnd(jps_co2)%laction ) CALL cpl_prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 1305 1435 ! 1306 1436 #endif 1437 ! ! ------------------------- ! 1307 1438 IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current ! 1308 1439 ! ! ------------------------- ! … … 1316 1447 ! i-1 i i 1317 1448 ! i i+1 (for I) 1318 SELECT CASE( TRIM( cn_snd_crt(1)) )1449 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1319 1450 CASE( 'oce only' ) ! C-grid ==> T 1320 1451 DO jj = 2, jpjm1 … … 1394 1525 END SELECT 1395 1526 END SELECT 1396 CALL lbc_lnk( zotx1, 'T', -1. ) ; CALL lbc_lnk( zoty1, 'T', -1. )1527 CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 1397 1528 ! 1398 1529 ! 1399 IF( TRIM( cn_snd_crt(3)) == 'eastward-northward' ) THEN ! Rotation of the components1530 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 1400 1531 ! ! Ocean component 1401 1532 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component … … 1412 1543 ! 1413 1544 ! spherical coordinates to cartesian -> 2 components to 3 components 1414 IF( TRIM( cn_snd_crt(2)) == 'cartesian' ) THEN1545 IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN 1415 1546 ztmp1(:,:) = zotx1(:,:) ! ocean currents 1416 1547 ztmp2(:,:) = zoty1(:,:) … … 1424 1555 ENDIF 1425 1556 ! 1426 IF( ssnd(jps_ocx1)%laction ) CALL cpl_prism_snd( jps_ocx1, isec, zotx1, info ) ! ocean x current 1st grid1427 IF( ssnd(jps_ocy1)%laction ) CALL cpl_prism_snd( jps_ocy1, isec, zoty1, info ) ! ocean y current 1st grid1428 IF( ssnd(jps_ocz1)%laction ) CALL cpl_prism_snd( jps_ocz1, isec, zotz1, info ) ! ocean z current 1st grid1557 IF( ssnd(jps_ocx1)%laction ) CALL cpl_prism_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid 1558 IF( ssnd(jps_ocy1)%laction ) CALL cpl_prism_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid 1559 IF( ssnd(jps_ocz1)%laction ) CALL cpl_prism_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid 1429 1560 ! 1430 IF( ssnd(jps_ivx1)%laction ) CALL cpl_prism_snd( jps_ivx1, isec, zitx1, info ) ! ice x current 1st grid1431 IF( ssnd(jps_ivy1)%laction ) CALL cpl_prism_snd( jps_ivy1, isec, zity1, info ) ! ice y current 1st grid1432 IF( ssnd(jps_ivz1)%laction ) CALL cpl_prism_snd( jps_ivz1, isec, zitz1, info ) ! ice z current 1st grid1561 IF( ssnd(jps_ivx1)%laction ) CALL cpl_prism_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid 1562 IF( ssnd(jps_ivy1)%laction ) CALL cpl_prism_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid 1563 IF( ssnd(jps_ivz1)%laction ) CALL cpl_prism_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid 1433 1564 ! 1434 1565 ENDIF 1435 1566 ! 1436 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9) ) CALL ctl_stop('sbc_cpl_snd: failed to release workspace arrays')1567 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9) .OR. wrk_not_released(3, 1,2) ) CALL ctl_stop('sbc_cpl_snd: failed to release workspace arrays') 1437 1568 ! 1438 1569 END SUBROUTINE sbc_cpl_snd … … 1459 1590 END SUBROUTINE sbc_cpl_ice_tau 1460 1591 ! 1461 SUBROUTINE sbc_cpl_ice_flx( p_frld , & 1462 & pqns_tot, pqns_ice, pqsr_tot , pqsr_ice, & 1463 & pemp_tot, pemp_ice, pdqns_ice, psprecip, & 1464 & palbi , psst , pist ) 1465 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: p_frld ! lead fraction [0 to 1] 1466 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqns_tot ! total non solar heat flux [W/m2] 1467 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqns_ice ! ice non solar heat flux [W/m2] 1468 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqsr_tot ! total solar heat flux [W/m2] 1469 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqsr_ice ! ice solar heat flux [W/m2] 1470 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_tot ! total freshwater budget [Kg/m2/s] 1471 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_ice ! ice solid freshwater budget [Kg/m2/s] 1472 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pdqns_ice ! d(Q non solar)/d(Temperature) over ice 1473 REAL(wp), INTENT( out), DIMENSION(:,: ) :: psprecip ! solid precipitation [Kg/m2/s] 1592 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist ) 1593 REAL(wp), INTENT(in ), DIMENSION(:,: ) :: p_frld ! lead fraction [0 to 1] 1474 1594 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! ice albedo 1475 1595 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celcius] 1476 1596 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1477 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1,1), palbi(1,1,1), psst(1,1), pist(1,1,1) 1478 ! stupid definition to avoid warning message when compiling... 1479 pqns_tot(:,:) = 0. ; pqns_ice(:,:,:) = 0. ; pdqns_ice(:,:,:) = 0. 1480 pqsr_tot(:,:) = 0. ; pqsr_ice(:,:,:) = 0. 1481 pemp_tot(:,:) = 0. ; pemp_ice(:,:) = 0. ; psprecip(:,:) = 0. 1597 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) 1482 1598 END SUBROUTINE sbc_cpl_ice_flx 1483 1599
Note: See TracChangeset
for help on using the changeset viewer.
