Changeset 2813
- Timestamp:
- 2011-07-21T14:33:51+02:00 (13 years ago)
- Location:
- branches/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM
- Files:
-
- 5 edited
-
CONFIG/ORCA2_LIM/EXP00/namelist (modified) (2 diffs)
-
NEMO/LIM_SRC_2/limsbc_2.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/SBC/cpl_oasis3.F90 (modified) (6 diffs)
-
NEMO/OPA_SRC/SBC/sbccpl.F90 (modified) (59 diffs)
-
NEMO/OPA_SRC/SBC/sbcice_if.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist
r2715 r2813 121 121 !! namsbc_core CORE bulk formulea formulation 122 122 !! namsbc_cpl CouPLed formulation ("key_coupled") 123 !! namsbc_cpl_co2 coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle")124 123 !! namtra_qsr penetrative solar radiation 125 124 !! namsbc_rnf river runoffs … … 212 211 &namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled") 213 212 !----------------------------------------------------------------------- 214 ! ! send 215 cn_snd_temperature= 'weighted oce and ice' ! 'oce only' 'weighted oce and ice' 'mixed oce-ice' 216 cn_snd_albedo = 'weighted ice' ! 'none' 'weighted ice' 'mixed oce-ice' 217 cn_snd_thickness = 'none' ! 'none' 'weighted ice and snow' 218 cn_snd_crt_nature = 'none' ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 219 cn_snd_crt_refere = 'spherical' ! 'spherical' 'cartesian' 220 cn_snd_crt_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 221 cn_snd_crt_grid = 'T' ! 'T' 222 ! ! receive 223 cn_rcv_w10m = 'none' ! 'none' 'coupled' 224 cn_rcv_taumod = 'coupled' ! 'none' 'coupled' 225 cn_rcv_tau_nature = 'oce only' ! 'oce only' 'oce and ice' 'mixed oce-ice' 226 cn_rcv_tau_refere = 'cartesian' ! 'spherical' 'cartesian' 227 cn_rcv_tau_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 228 cn_rcv_tau_grid = 'U,V' ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 229 cn_rcv_dqnsdt = 'coupled' ! 'none' 'coupled' 230 cn_rcv_qsr = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 231 cn_rcv_qns = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 232 cn_rcv_emp = 'conservative' ! 'conservative' 'oce and ice' 'mixed oce-ice' 233 cn_rcv_rnf = 'coupled' ! 'coupled' 'climato' 'mixed' 234 cn_rcv_cal = 'coupled' ! 'none' 'coupled' 235 / 236 !----------------------------------------------------------------------- 237 &namsbc_cpl_co2 ! coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle") 238 !----------------------------------------------------------------------- 239 cn_snd_co2 = 'coupled' ! send : 'none' 'coupled' 240 cn_rcv_co2 = 'coupled' ! receive : 'none' 'coupled' 213 ! ! description ! multiple ! vector ! vector ! vector ! 214 ! ! ! categories ! reference ! orientation ! grids ! 215 ! send 216 sn_snd_temp = 'weighted oce and ice' , 'no' , '' , '' , '' 217 sn_snd_alb = 'weighted ice' , 'no' , '' , '' , '' 218 sn_snd_thick = 'none' , 'no' , '' , '' , '' 219 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' 220 sn_snd_co2 = 'coupled' , 'no' , '' , '' , '' 221 ! receive 222 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' 223 sn_rcv_taumod = 'coupled' , 'no' , '' , '' , '' 224 sn_rcv_tau = 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' 225 sn_rcv_dqnsdt = 'coupled' , 'no' , '' , '' , '' 226 sn_rcv_qsr = 'oce and ice' , 'no' , '' , '' , '' 227 sn_rcv_qns = 'oce and ice' , 'no' , '' , '' , '' 228 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 229 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 230 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 231 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 241 232 / 242 233 !----------------------------------------------------------------------- -
branches/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r2715 r2813 27 27 USE sbc_ice ! surface boundary condition: ice 28 28 USE sbc_oce ! surface boundary condition: ocean 29 USE sbccpl 29 30 30 31 USE albedo ! albedo parameters … … 234 235 !-----------------------------------------------! 235 236 236 IF( lk_cpl ) THEN ! coupled case 237 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature 238 ! ! Computation of snow/ice and ocean albedo 239 CALL albedo_ice( tn_ice, reshape( hicif, (/jpi,jpj,1/) ), reshape( hsnif, (/jpi,jpj,1/) ), zalbp, zalb ) 240 alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys) 241 CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) ) ! ice albedo 242 ENDIF 237 #if defined key_coupled 238 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature 239 ht_i(:,:,1) = hicif(:,:) 240 ht_s(:,:,1) = hsnif(:,:) 241 a_i(:,:,1) = fr_i(:,:) 242 ! ! Computation of snow/ice and ocean albedo 243 CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb ) 244 alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys) 245 CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) ) ! ice albedo 246 #endif 243 247 244 248 IF(ln_ctl) THEN ! control print -
branches/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r2715 r2813 52 52 INTEGER, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields 53 53 54 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information 55 LOGICAL :: laction ! To be coupled or not 56 CHARACTER(len = 8) :: clname ! Name of the coupling field 57 CHARACTER(len = 1) :: clgrid ! Grid type 58 REAL(wp) :: nsgn ! Control of the sign change 59 INTEGER :: nid ! Id of the field 54 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information 55 LOGICAL :: laction ! To be coupled or not 56 CHARACTER(len = 8) :: clname ! Name of the coupling field 57 CHARACTER(len = 1) :: clgrid ! Grid type 58 REAL(wp) :: nsgn ! Control of the sign change 59 INTEGER, DIMENSION(9) :: nid ! Id of the field (no more than 9 categories) 60 INTEGER :: nct ! Number of categories in field 60 61 END TYPE FLD_CPL 61 62 … … 118 119 INTEGER :: paral(5) ! OASIS3 box partition 119 120 INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe 120 INTEGER :: ji ! local loop indicees 121 INTEGER :: ji,jc ! local loop indicees 122 CHARACTER(LEN=8) :: zclname 121 123 !!-------------------------------------------------------------------- 122 124 … … 164 166 DO ji = 1, ksnd 165 167 IF ( ssnd(ji)%laction ) THEN 166 CALL prism_def_var_proto (ssnd(ji)%nid, ssnd(ji)%clname, id_part, (/ 2, 0/), & 167 & PRISM_Out , ishape , PRISM_REAL, nerror) 168 IF ( nerror /= PRISM_Ok ) THEN 169 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(ssnd(ji)%clname) 170 CALL prism_abort_proto ( ssnd(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var') 171 ENDIF 168 DO jc = 1, ssnd(ji)%nct 169 IF ( ssnd(ji)%nct .gt. 1 ) THEN 170 WRITE(zclname,'( a7, i1)') ssnd(ji)%clname,jc 171 ELSE 172 zclname=ssnd(ji)%clname 173 ENDIF 174 WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_Out 175 CALL prism_def_var_proto (ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/), & 176 PRISM_Out, ishape, PRISM_REAL, nerror) 177 IF ( nerror /= PRISM_Ok ) THEN 178 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 179 CALL prism_abort_proto ( ssnd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 180 ENDIF 181 END DO 172 182 ENDIF 173 183 END DO … … 177 187 DO ji = 1, krcv 178 188 IF ( srcv(ji)%laction ) THEN 179 CALL prism_def_var_proto ( srcv(ji)%nid, srcv(ji)%clname, id_part, (/ 2, 0/), & 180 & PRISM_In , ishape , PRISM_REAL, nerror) 181 IF ( nerror /= PRISM_Ok ) THEN 182 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(srcv(ji)%clname) 183 CALL prism_abort_proto ( srcv(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var') 184 ENDIF 189 DO jc = 1, srcv(ji)%nct 190 IF ( srcv(ji)%nct .gt. 1 ) THEN 191 WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc 192 ELSE 193 zclname=srcv(ji)%clname 194 ENDIF 195 WRITE(numout,*) "Define",ji,zclname," for",PRISM_In 196 CALL prism_def_var_proto ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/), & 197 & PRISM_In , ishape , PRISM_REAL, nerror) 198 IF ( nerror /= PRISM_Ok ) THEN 199 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 200 CALL prism_abort_proto ( srcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 201 ENDIF 202 END DO 185 203 ENDIF 186 204 END DO … … 203 221 !! like sst or ice cover to the coupler or remote application. 204 222 !!---------------------------------------------------------------------- 205 INTEGER , INTENT(in ) :: kid ! variable index in the array 206 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 207 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 208 REAL(wp), DIMENSION(:,:), INTENT(in ) :: pdata 223 INTEGER , INTENT(in ) :: kid ! variable index in the array 224 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 225 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 226 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdata 227 !! 228 INTEGER :: jc ! local loop index 209 229 !!-------------------------------------------------------------------- 210 230 ! 211 231 ! snd data to OASIS3 212 232 ! 213 CALL prism_put_proto ( ssnd(kid)%nid, kstep, pdata(nldi:nlei, nldj:nlej), kinfo ) 214 215 IF ( ln_ctl ) THEN 216 IF ( kinfo == PRISM_Sent .OR. kinfo == PRISM_ToRest .OR. & 217 & kinfo == PRISM_SentOut .OR. kinfo == PRISM_ToRestOut ) THEN 218 WRITE(numout,*) '****************' 219 WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 220 WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid 221 WRITE(numout,*) 'prism_put_proto: kstep ', kstep 222 WRITE(numout,*) 'prism_put_proto: info ', kinfo 223 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata) 224 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata) 225 WRITE(numout,*) ' - Sum value is ', SUM(pdata) 226 WRITE(numout,*) '****************' 233 DO jc = 1, ssnd(kid)%nct 234 235 CALL prism_put_proto ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 236 237 IF ( ln_ctl ) THEN 238 IF ( kinfo == PRISM_Sent .OR. kinfo == PRISM_ToRest .OR. & 239 & kinfo == PRISM_SentOut .OR. kinfo == PRISM_ToRestOut ) THEN 240 WRITE(numout,*) '****************' 241 WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 242 WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid(jc) 243 WRITE(numout,*) 'prism_put_proto: kstep ', kstep 244 WRITE(numout,*) 'prism_put_proto: info ', kinfo 245 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 246 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 247 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 248 WRITE(numout,*) '****************' 249 ENDIF 227 250 ENDIF 228 ENDIF 251 252 ENDDO 229 253 ! 230 254 END SUBROUTINE cpl_prism_snd … … 238 262 !! like stresses and fluxes from the coupler or remote application. 239 263 !!---------------------------------------------------------------------- 240 INTEGER , INTENT(in ) :: kid ! variable index in the array 241 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 242 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pdata ! IN to keep the value if nothing is done 243 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 244 !! 245 LOGICAL :: llaction 264 INTEGER , INTENT(in ) :: kid ! variable index in the array 265 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 266 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdata ! IN to keep the value if nothing is done 267 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 268 !! 269 INTEGER :: jc ! local loop index 270 LOGICAL :: llaction 246 271 !!-------------------------------------------------------------------- 247 272 ! 248 273 ! receive local data from OASIS3 on every process 249 274 ! 250 CALL prism_get_proto ( srcv(kid)%nid, kstep, exfld, kinfo ) 251 252 llaction = .false. 253 IF( kinfo == PRISM_Recvd .OR. kinfo == PRISM_FromRest .OR. & 254 kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut ) llaction = .TRUE. 255 256 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid 257 258 IF ( llaction ) THEN 259 260 kinfo = OASIS_Rcv 261 pdata(nldi:nlei, nldj:nlej) = exfld(:,:) 262 263 !--- Fill the overlap areas and extra hallows (mpp) 264 !--- check periodicity conditions (all cases) 265 CALL lbc_lnk( pdata, srcv(kid)%clgrid, srcv(kid)%nsgn ) 266 267 IF ( ln_ctl ) THEN 268 WRITE(numout,*) '****************' 269 WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 270 WRITE(numout,*) 'prism_get_proto: ivarid ' , srcv(kid)%nid 271 WRITE(numout,*) 'prism_get_proto: kstep', kstep 272 WRITE(numout,*) 'prism_get_proto: info ', kinfo 273 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata) 274 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata) 275 WRITE(numout,*) ' - Sum value is ', SUM(pdata) 276 WRITE(numout,*) '****************' 275 DO jc = 1, srcv(kid)%nct 276 277 CALL prism_get_proto ( srcv(kid)%nid(jc), kstep, exfld, kinfo ) 278 279 llaction = .false. 280 IF( kinfo == PRISM_Recvd .OR. kinfo == PRISM_FromRest .OR. & 281 kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut ) llaction = .TRUE. 282 283 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc) 284 285 IF ( llaction ) THEN 286 287 kinfo = OASIS_Rcv 288 pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 289 290 !--- Fill the overlap areas and extra hallows (mpp) 291 !--- check periodicity conditions (all cases) 292 CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 293 294 IF ( ln_ctl ) THEN 295 WRITE(numout,*) '****************' 296 WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 297 WRITE(numout,*) 'prism_get_proto: ivarid ' , srcv(kid)%nid(jc) 298 WRITE(numout,*) 'prism_get_proto: kstep', kstep 299 WRITE(numout,*) 'prism_get_proto: info ', kinfo 300 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 301 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 302 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 303 WRITE(numout,*) '****************' 304 ENDIF 305 306 ELSE 307 kinfo = OASIS_idle 277 308 ENDIF 278 279 ELSE 280 kinfo = OASIS_idle 281 ENDIF 309 310 ENDDO 282 311 ! 283 312 END SUBROUTINE cpl_prism_rcv -
branches/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r2812 r2813 41 41 USE geo2ocean ! 42 42 USE restart ! 43 USE oce , ONLY : t n, un, vn43 USE oce , ONLY : tsn, un, vn 44 44 USE albedo ! 45 45 USE in_out_manager ! I/O manager … … 51 51 #endif 52 52 USE diaar5, ONLY : lk_diaar5 53 #if defined key_cice 54 USE ice_domain_size, only: ncat 55 #endif 53 56 IMPLICIT NONE 54 57 PRIVATE … … 89 92 INTEGER, PARAMETER :: jpr_cal = 29 ! calving 90 93 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 94 INTEGER, PARAMETER :: jpr_co2 = 31 95 95 INTEGER, PARAMETER :: jprcv = 31 ! total number of fields received 96 #endif 96 97 97 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction 98 98 INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature … … 109 109 INTEGER, PARAMETER :: jps_ivy1 = 13 ! 110 110 INTEGER, PARAMETER :: jps_ivz1 = 14 ! 111 #if ! defined key_cpl_carbon_cycle112 INTEGER, PARAMETER :: jpsnd = 14 ! total number of fields sended113 #else114 111 INTEGER, PARAMETER :: jps_co2 = 15 115 112 INTEGER, PARAMETER :: jpsnd = 15 ! total number of fields sended 116 #endif 113 117 114 ! !!** 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' 115 TYPE :: FLD_C 116 CHARACTER(len = 32) :: cldes ! desciption of the coupling strategy 117 CHARACTER(len = 32) :: clcat ! multiple ice categories strategy 118 CHARACTER(len = 32) :: clvref ! reference of vector ('spherical' or 'cartesian') 119 CHARACTER(len = 32) :: clvor ! orientation of vector fields ('eastward-northward' or 'local grid') 120 CHARACTER(len = 32) :: clvgrd ! grids on which is located the vector fields 121 END TYPE FLD_C 122 ! Send to the atmosphere ! 123 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 124 ! Received from the atmosphere ! 125 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 126 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 127 128 TYPE :: DYNARR 129 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 130 END TYPE DYNARR 131 132 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere 133 134 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 135 136 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument 137 138 #if ! defined key_lim2 && ! defined key_lim3 139 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 140 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice, alb_ice ! (jpi,jpj,jpl) 128 141 #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' 142 143 #if defined key_cice 144 INTEGER, PARAMETER :: jpl = ncat 145 #elif ! defined key_lim2 && ! defined key_lim3 146 INTEGER, PARAMETER :: jpl = 1 144 147 #endif 145 148 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 149 #if ! defined key_lim3 && ! defined key_cice 150 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i 151 #endif 152 153 #if ! defined key_lim3 154 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i, ht_s 162 155 #endif 163 156 … … 176 169 !! *** FUNCTION sbc_cpl_alloc *** 177 170 !!---------------------------------------------------------------------- 178 INTEGER :: ierr( 2)171 INTEGER :: ierr(4),jn 179 172 !!---------------------------------------------------------------------- 180 173 ierr(:) = 0 181 174 ! 182 ALLOCATE( albedo_oce_mix(jpi,jpj), frcv(jpi,jpj,jprcv),nrcvinfo(jprcv), STAT=ierr(1) )175 ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) ) 183 176 ! 184 177 #if ! defined key_lim2 && ! defined key_lim3 185 178 ! 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) ) 179 ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , & 180 v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1) , STAT=ierr(2) ) 181 #endif 182 183 #if ! defined key_lim3 && ! defined key_cice 184 ALLOCATE( a_i(jpi,jpj,jpl) , STAT=ierr(3) ) 185 #endif 186 187 #if defined key_cice || defined key_lim2 188 ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(4) ) 188 189 #endif 189 190 sbc_cpl_alloc = MAXVAL( ierr ) … … 213 214 INTEGER :: jn ! dummy loop index 214 215 !! 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 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_co2 223 219 !!--------------------------------------------------------------------- 224 220 … … 230 226 ! Namelist informations ! 231 227 ! ================================ ! 228 229 ! default definitions 230 ! ! description ! multiple ! vector ! vector ! vector ! 231 ! ! ! categories ! reference ! orientation ! grids ! 232 ! send 233 sn_snd_temp = FLD_C( 'weighted oce and ice', 'no' , '' , '' , '' ) 234 sn_snd_alb = FLD_C( 'weighted ice' , 'no' , '' , '' , '' ) 235 sn_snd_thick = FLD_C( 'none' , 'no' , '' , '' , '' ) 236 sn_snd_crt = FLD_C( 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' ) 237 sn_snd_co2 = FLD_C( 'none' , 'no' , '' , '' , '' ) 238 ! receive 239 sn_rcv_w10m = FLD_C( 'none' , 'no' , '' , '' , '' ) 240 sn_rcv_taumod = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 241 sn_rcv_tau = FLD_C( 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' ) 242 sn_rcv_dqnsdt = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 243 sn_rcv_qsr = FLD_C( 'oce and ice' , 'no' , '' , '' , '' ) 244 sn_rcv_qns = FLD_C( 'oce and ice' , 'no' , '' , '' , '' ) 245 sn_rcv_emp = FLD_C( 'conservative' , 'no' , '' , '' , '' ) 246 sn_rcv_rnf = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 247 sn_rcv_cal = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 248 sn_rcv_co2 = FLD_C( 'none' , 'no' , '' , '' , '' ) 232 249 233 250 REWIND( numnam ) ! ... read namlist namsbc_cpl … … 238 255 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 239 256 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 257 WRITE(numout,*)' received fields (mutiple ice categogies)' 258 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' 259 WRITE(numout,*)' stress module = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')' 260 WRITE(numout,*)' surface stress = ', TRIM(sn_rcv_tau%cldes ), ' (', TRIM(sn_rcv_tau%clcat ), ')' 261 WRITE(numout,*)' - referential = ', sn_rcv_tau%clvref 262 WRITE(numout,*)' - orientation = ', sn_rcv_tau%clvor 263 WRITE(numout,*)' - mesh = ', sn_rcv_tau%clvgrd 264 WRITE(numout,*)' non-solar heat flux sensitivity = ', TRIM(sn_rcv_dqnsdt%cldes), ' (', TRIM(sn_rcv_dqnsdt%clcat), ')' 265 WRITE(numout,*)' solar heat flux = ', TRIM(sn_rcv_qsr%cldes ), ' (', TRIM(sn_rcv_qsr%clcat ), ')' 266 WRITE(numout,*)' non-solar heat flux = ', TRIM(sn_rcv_qns%cldes ), ' (', TRIM(sn_rcv_qns%clcat ), ')' 267 WRITE(numout,*)' freshwater budget = ', TRIM(sn_rcv_emp%cldes ), ' (', TRIM(sn_rcv_emp%clcat ), ')' 268 WRITE(numout,*)' runoffs = ', TRIM(sn_rcv_rnf%cldes ), ' (', TRIM(sn_rcv_rnf%clcat ), ')' 269 WRITE(numout,*)' calving = ', TRIM(sn_rcv_cal%cldes ), ' (', TRIM(sn_rcv_cal%clcat ), ')' 270 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 271 WRITE(numout,*)' sent fields (mutiple ice categogies)' 272 WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')' 273 WRITE(numout,*)' albedo = ', TRIM(sn_snd_alb%cldes ), ' (', TRIM(sn_snd_alb%clcat ), ')' 274 WRITE(numout,*)' ice/snow thickness = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')' 275 WRITE(numout,*)' surface current = ', TRIM(sn_snd_crt%cldes ), ' (', TRIM(sn_snd_crt%clcat ), ')' 276 WRITE(numout,*)' - referential = ', sn_snd_crt%clvref 277 WRITE(numout,*)' - orientation = ', sn_snd_crt%clvor 278 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 279 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 280 ENDIF 281 282 ! ! allocate sbccpl arrays 284 283 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 285 284 … … 294 293 295 294 ! default definitions of srcv 296 srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. 295 srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1 297 296 298 297 ! ! ------------------------- ! … … 315 314 ! 316 315 ! 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.316 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 318 317 319 318 ! ! 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'319 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 320 CASE( 'T' ) 322 321 srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point … … 364 363 srcv(jpr_itx1:jpr_itz2)%laction = .TRUE. ! receive ice components on grid 1 & 2 365 364 CASE default 366 CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_tau(4)' )365 CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' ) 367 366 END SELECT 368 367 ! 369 IF( TRIM( cn_rcv_tau(2)) == 'spherical' ) & ! spherical: 3rd component not received368 IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' ) & ! spherical: 3rd component not received 370 369 & srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE. 371 370 ! 372 IF( TRIM( cn_rcv_tau(1)) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used371 IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used 373 372 srcv(jpr_itx1:jpr_itz2)%laction = .FALSE. ! ice components not received 374 373 srcv(jpr_itx1)%clgrid = 'U' ! ocean stress used after its transformation … … 388 387 srcv(jpr_semp)%clname = 'OISubMSn' ! ice solid water budget = sublimation - solid precipitation 389 388 srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip 390 SELECT CASE( TRIM( cn_rcv_emp) )389 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 391 390 CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE. 392 391 CASE( 'conservative' ) ; srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 393 392 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' )393 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 395 394 END SELECT 396 395 … … 398 397 ! ! Runoffs & Calving ! 399 398 ! ! ------------------------- ! 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.399 srcv(jpr_rnf )%clname = 'O_Runoff' ; IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 400 ! IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' ) THEN ; ln_rnf = .TRUE. 401 ! ELSE ; ln_rnf = .FALSE. 403 402 ! ENDIF 404 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( cn_rcv_cal) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE.403 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 405 404 406 405 ! ! ------------------------- ! … … 410 409 srcv(jpr_qnsice)%clname = 'O_QnsIce' 411 410 srcv(jpr_qnsmix)%clname = 'O_QnsMix' 412 SELECT CASE( TRIM( cn_rcv_qns ) )411 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 413 412 CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE. 414 413 CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. 415 414 CASE( 'oce and ice' ) ; srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE. 416 415 CASE( 'mixed oce-ice' ) ; srcv( jpr_qnsmix )%laction = .TRUE. 417 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qns' )416 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' ) 418 417 END SELECT 419 418 … … 424 423 srcv(jpr_qsrice)%clname = 'O_QsrIce' 425 424 srcv(jpr_qsrmix)%clname = 'O_QsrMix' 426 SELECT CASE( TRIM( cn_rcv_qsr) )425 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 427 426 CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE. 428 427 CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. 429 428 CASE( 'oce and ice' ) ; srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE. 430 429 CASE( 'mixed oce-ice' ) ; srcv( jpr_qsrmix )%laction = .TRUE. 431 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qsr' )430 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' ) 432 431 END SELECT 433 432 … … 436 435 ! ! ------------------------- ! 437 436 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' )437 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' ) srcv(jpr_dqnsdt)%laction = .TRUE. 438 ! 439 ! non solar sensitivity mandatory for LIM ice model 440 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) & 441 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 443 442 ! 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' )443 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) & 444 CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' ) 446 445 ! ! ------------------------- ! 447 446 ! ! Ice Qsr penetration ! … … 456 455 ! ! 10m wind module ! 457 456 ! ! ------------------------- ! 458 srcv(jpr_w10m)%clname = 'O_Wind10' ; IF( TRIM( cn_rcv_w10m) == 'coupled' ) srcv(jpr_w10m)%laction = .TRUE.457 srcv(jpr_w10m)%clname = 'O_Wind10' ; IF( TRIM(sn_rcv_w10m%cldes ) == 'coupled' ) srcv(jpr_w10m)%laction = .TRUE. 459 458 ! 460 459 ! ! ------------------------- ! 461 460 ! ! wind stress module ! 462 461 ! ! ------------------------- ! 463 srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM( cn_rcv_taumod) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE.462 srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE. 464 463 lhftau = srcv(jpr_taum)%laction 465 464 466 #if defined key_cpl_carbon_cycle467 465 ! ! ------------------------- ! 468 466 ! ! Atmospheric CO2 ! 469 467 ! ! ------------------------- ! 470 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(cn_rcv_co2 ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 471 #endif 472 468 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 469 470 DO jn = 1, jprcv 471 ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 472 END DO 473 473 474 ! ================================ ! 474 475 ! Define the send interface ! 475 476 ! ================================ ! 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)477 ! for each field: define the OASIS name (ssnd(:)%clname) 478 ! define send or not from the namelist parameters (ssnd(:)%laction) 479 ! define the north fold type of lbc (ssnd(:)%nsgn) 479 480 480 481 ! default definitions of nsnd 481 ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. 482 ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1 482 483 483 484 ! ! ------------------------- ! … … 487 488 ssnd(jps_tice)%clname = 'O_TepIce' 488 489 ssnd(jps_tmix)%clname = 'O_TepMix' 489 SELECT CASE( TRIM( cn_snd_temperature) )490 SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 490 491 CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE. 491 CASE( 'weighted oce and ice' ) ; ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 492 CASE( 'weighted oce and ice' ) 493 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 494 IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl 492 495 CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE. 493 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_temperature' )496 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 494 497 END SELECT 495 498 … … 499 502 ssnd(jps_albice)%clname = 'O_AlbIce' 500 503 ssnd(jps_albmix)%clname = 'O_AlbMix' 501 SELECT CASE( TRIM( cn_snd_albedo) )504 SELECT CASE( TRIM( sn_snd_alb%cldes ) ) 502 505 CASE( 'none' ) ! nothing to do 503 506 CASE( 'weighted ice' ) ; ssnd(jps_albice)%laction = .TRUE. 504 507 CASE( 'mixed oce-ice' ) ; ssnd(jps_albmix)%laction = .TRUE. 505 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_albedo' )508 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' ) 506 509 END SELECT 507 510 ! … … 509 512 ! 1. sending mixed oce-ice albedo or 510 513 ! 2. receiving mixed oce-ice solar radiation 511 IF ( TRIM ( cn_snd_albedo ) == 'mixed oce-ice' .OR. TRIM ( cn_rcv_qsr) == 'mixed oce-ice' ) THEN514 IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 512 515 CALL albedo_oce( zaos, zacs ) 513 516 ! Due to lack of information on nebulosity : mean clear/overcast sky … … 518 521 ! ! Ice fraction & Thickness ! 519 522 ! ! ------------------------- ! 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 523 ssnd(jps_fice)%clname = 'OIceFrc' 524 ssnd(jps_hsnw)%clname = 'OSnwTck' 525 ssnd(jps_hice)%clname = 'OIceTck' 526 IF( k_ice /= 0 ) THEN 527 ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case) 528 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 529 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 530 ENDIF 531 532 SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 533 CASE ( 'ice and snow' ) 534 ssnd(jps_hsnw:jps_hice)%laction = .TRUE. 535 ssnd(jps_hsnw:jps_hice)%nct = jpl 536 CASE ( 'weighted ice and snow' ) 537 ssnd(jps_hsnw:jps_hice)%laction = .TRUE. 538 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hsnw:jps_hice)%nct = jpl 539 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 540 END SELECT 541 526 542 ! ! ------------------------- ! 527 543 ! ! Surface current ! … … 534 550 ssnd(jps_ocx1:jps_ivz1)%nsgn = -1. ! vectors: change of the sign at the north fold 535 551 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 552 IF( sn_snd_crt%clvgrd == 'U,V' ) THEN 553 ssnd(jps_ocx1)%clgrid = 'U' ; ssnd(jps_ocy1)%clgrid = 'V' 554 ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN 555 CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' ) 556 ssnd(jps_ocx1:jps_ivz1)%clgrid = 'T' ! all oce and ice components on the same unique grid 557 ENDIF 539 558 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) ) ) 559 IF( TRIM( sn_snd_crt%clvref ) == 'spherical' ) ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE. 560 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) ssnd(jps_ocx1:jps_ivz1)%nsgn = 1. 561 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 542 562 CASE( 'none' ) ; ssnd(jps_ocx1:jps_ivz1)%laction = .FALSE. 543 563 CASE( 'oce only' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 544 564 CASE( 'weighted oce and ice' ) ! nothing to do 545 565 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)' )566 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crt%cldes' ) 547 567 END SELECT 548 568 549 #if defined key_cpl_carbon_cycle550 569 ! ! ------------------------- ! 551 570 ! ! CO2 flux ! 552 571 ! ! ------------------------- ! 553 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(cn_snd_co2) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 554 #endif 572 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 555 573 ! 556 574 ! ================================ ! … … 636 654 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 637 655 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) )656 IF( srcv(jn)%laction ) CALL cpl_prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) ) 639 657 END DO 640 658 … … 642 660 IF( srcv(jpr_otx1)%laction ) THEN ! ocean stress components ! 643 661 ! ! ========================= ! 644 ! define frcv( :,:,jpr_otx1) and frcv(:,:,jpr_oty1): stress at U/V point along model grid662 ! define frcv(jpr_otx1)%z3(:,:,1) and frcv(jpr_oty1)%z3(:,:,1): stress at U/V point along model grid 645 663 ! => need to be done only when we receive the field 646 664 IF( nrcvinfo(jpr_otx1) == OASIS_Rcv ) THEN 647 665 ! 648 IF( TRIM( cn_rcv_tau(2)) == 'cartesian' ) THEN ! 2 components on the sphere666 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere 649 667 ! ! (cartesian to spherical -> 3 to 2 components) 650 668 ! 651 CALL geo2oce( frcv( :,:,jpr_otx1), frcv(:,:,jpr_oty1), frcv(:,:,jpr_otz1), &669 CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1), & 652 670 & 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 grid671 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid 672 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid 655 673 ! 656 674 IF( srcv(jpr_otx2)%laction ) THEN 657 CALL geo2oce( frcv( :,:,jpr_otx2), frcv(:,:,jpr_oty2), frcv(:,:,jpr_otz2), &675 CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1), & 658 676 & 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 grid677 frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid 678 frcv(jpr_oty2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid 661 679 ENDIF 662 680 ! 663 681 ENDIF 664 682 ! 665 IF( TRIM( cn_rcv_tau(3)) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid683 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 666 684 ! ! (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 grid685 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 686 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 669 687 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 )688 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 689 ELSE 690 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 673 691 ENDIF 674 frcv( :,:,jpr_oty1) = zty(:,:) ! overwrite 2nd component on the 2nd grid692 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 675 693 ENDIF 676 694 ! … … 678 696 DO jj = 2, jpjm1 ! T ==> (U,V) 679 697 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) )698 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 699 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 700 END DO 683 701 END DO 684 CALL lbc_lnk( frcv( :,:,jpr_otx1), 'U', -1. ) ; CALL lbc_lnk( frcv(:,:,jpr_oty1), 'V', -1. )702 CALL lbc_lnk( frcv(jpr_otx1)%z3(:,:,1), 'U', -1. ) ; CALL lbc_lnk( frcv(jpr_oty1)%z3(:,:,1), 'V', -1. ) 685 703 ENDIF 686 704 llnewtx = .TRUE. … … 691 709 ELSE ! No dynamical coupling ! 692 710 ! ! ========================= ! 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 instead711 frcv(jpr_otx1)%z3(:,:,1) = 0.e0 ! here simply set to zero 712 frcv(jpr_oty1)%z3(:,:,1) = 0.e0 ! an external read in a file can be added instead 695 713 llnewtx = .TRUE. 696 714 ! … … 708 726 !CDIR NOVERRCHK 709 727 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 )728 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 729 zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) 730 frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 713 731 END DO 714 732 END DO 715 CALL lbc_lnk( frcv( :,:,jpr_taum), 'T', 1. )733 CALL lbc_lnk( frcv(jpr_taum)%z3(:,:,1), 'T', 1. ) 716 734 llnewtau = .TRUE. 717 735 ELSE … … 722 740 ! Stress module can be negative when received (interpolation problem) 723 741 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 742 frcv(jpr_taum)%z3(:,:,1) = MAX( 0.0e0, frcv(jpr_taum)%z3(:,:,1) ) 729 743 ENDIF 730 744 ENDIF … … 742 756 !CDIR NOVERRCHK 743 757 DO ji = 1, jpi 744 frcv(j i,jj,jpr_w10m) = SQRT( frcv(ji,jj,jpr_taum) * zcoef )758 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_w10m)%z3(ji,jj,1) * zcoef ) 745 759 END DO 746 760 END DO … … 752 766 IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 753 767 ! 754 utau(:,:) = frcv( :,:,jpr_otx1)755 vtau(:,:) = frcv( :,:,jpr_oty1)756 taum(:,:) = frcv( :,:,jpr_taum)757 wndm(:,:) = frcv( :,:,jpr_w10m)768 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 769 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 770 taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 771 wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 758 772 CALL iom_put( "taum_oce", taum ) ! output wind stress module 759 773 ! … … 764 778 ! 765 779 ! ! 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)780 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 781 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 768 782 ! add the latent heat of solid precip. melting 769 IF( srcv(jpr_snow )%laction ) qns(:,:) = qns(:,:) - frcv( :,:,jpr_snow) * lfus783 IF( srcv(jpr_snow )%laction ) qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus 770 784 771 785 ! ! 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)786 IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 787 IF( srcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 774 788 IF( ln_dm2dc ) qsr(:,:) = sbc_dcy( qsr ) ! modify qsr to include the diurnal cycle 775 789 ! 776 790 ! ! total freshwater fluxes over the ocean (emp, emps) 777 SELECT CASE( TRIM( cn_rcv_emp) ) ! evaporation - precipitation791 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 778 792 CASE( 'conservative' ) 779 emp(:,:) = frcv( :,:,jpr_tevp) - ( frcv(:,:,jpr_rain) + frcv(:,:,jpr_snow) )793 emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 780 794 CASE( 'oce only', 'oce and ice' ) 781 emp(:,:) = frcv( :,:,jpr_oemp)795 emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 782 796 CASE default 783 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of cn_rcv_emp' )797 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 784 798 END SELECT 785 799 ! 786 800 ! ! 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)801 IF( srcv(jpr_rnf)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 802 IF( srcv(jpr_cal)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 789 803 ! 790 804 !!gm : this seems to be internal cooking, not sure to need that in a generic interface 791 805 !!gm at least should be optional... 792 !! IF( TRIM( cn_rcv_rnf) == 'coupled' ) THEN ! add to the total freshwater budget806 !! IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN ! add to the total freshwater budget 793 807 !! ! 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(:,:) )808 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 809 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 796 810 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) ! sum over the global domain 797 811 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 798 812 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 799 813 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 800 !! frcv( :,:,jpr_rnf) = MAX( frcv(:,:,jpr_rnf), 0.e0 ) * zcumulneg814 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 801 815 !! ENDIF 802 816 !! ! add runoff to e-p 803 !! emp(:,:) = emp(:,:) - frcv( :,:,jpr_rnf)817 !! emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 804 818 !! ENDIF 805 819 !!gm end of internal cooking … … 808 822 809 823 ! ! 10 m wind speed 810 IF( srcv(jpr_w10m)%laction ) wndm(:,:) = frcv( :,:,jpr_w10m)824 IF( srcv(jpr_w10m)%laction ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 811 825 ! 812 #if defined 826 #if defined key_cpl_carbon_cycle 813 827 ! ! atmosph. CO2 (ppm) 814 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv( :,:,jpr_co2)828 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 815 829 #endif 816 830 … … 880 894 ! ! ======================= ! 881 895 ! 882 IF( TRIM( cn_rcv_tau(2)) == 'cartesian' ) THEN ! 2 components on the sphere896 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere 883 897 ! ! (cartesian to spherical -> 3 to 2 components) 884 CALL geo2oce( frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1), frcv(:,:,jpr_itz1), &898 CALL geo2oce( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1), & 885 899 & srcv(jpr_itx1)%clgrid, ztx, zty ) 886 frcv( :,:,jpr_itx1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid887 frcv( :,:,jpr_ity1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid900 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid 901 frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid 888 902 ! 889 903 IF( srcv(jpr_itx2)%laction ) THEN 890 CALL geo2oce( frcv( :,:,jpr_itx2), frcv(:,:,jpr_ity2), frcv(:,:,jpr_itz2), &904 CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1), & 891 905 & 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 grid906 frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid 907 frcv(jpr_ity2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid 894 908 ENDIF 895 909 ! 896 910 ENDIF 897 911 ! 898 IF( TRIM( cn_rcv_tau(3)) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid912 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 899 913 ! ! (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 grid914 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx ) 915 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 902 916 IF( srcv(jpr_itx2)%laction ) THEN 903 CALL rot_rep( frcv( :,:,jpr_itx2), frcv(:,:,jpr_ity2), srcv(jpr_itx2)%clgrid, 'en->j', zty )917 CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty ) 904 918 ELSE 905 CALL rot_rep( frcv( :,:,jpr_itx1), frcv(:,:,jpr_ity1), srcv(jpr_itx1)%clgrid, 'en->j', zty )919 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty ) 906 920 ENDIF 907 frcv( :,:,jpr_ity1) = zty(:,:) ! overwrite 2nd component on the 1st grid921 frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid 908 922 ENDIF 909 923 ! ! ======================= ! 910 924 ELSE ! use ocean stress ! 911 925 ! ! ======================= ! 912 frcv( :,:,jpr_itx1) = frcv(:,:,jpr_otx1)913 frcv( :,:,jpr_ity1) = frcv(:,:,jpr_oty1)926 frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1) 927 frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1) 914 928 ! 915 929 ENDIF … … 934 948 DO jj = 2, jpjm1 ! (U,V) ==> I 935 949 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) )950 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji-1,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) ) 951 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) ) 938 952 END DO 939 953 END DO … … 941 955 DO jj = 2, jpjm1 ! F ==> I 942 956 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)957 p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji-1,jj-1,1) 958 p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji-1,jj-1,1) 945 959 END DO 946 960 END DO … … 948 962 DO jj = 2, jpjm1 ! T ==> I 949 963 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) )964 p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj ,1) & 965 & + frcv(jpr_itx1)%z3(ji,jj-1,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) ) 966 p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) & 967 & + frcv(jpr_oty1)%z3(ji,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) ) 954 968 END DO 955 969 END DO 956 970 CASE( 'I' ) 957 p_taui(:,:) = frcv( :,:,jpr_itx1) ! I ==> I958 p_tauj(:,:) = frcv( :,:,jpr_ity1)971 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! I ==> I 972 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 959 973 END SELECT 960 974 IF( srcv(jpr_itx1)%clgrid /= 'I' ) THEN … … 967 981 DO jj = 2, jpjm1 ! (U,V) ==> F 968 982 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) )983 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj+1,1) ) 984 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) ) 971 985 END DO 972 986 END DO … … 974 988 DO jj = 2, jpjm1 ! I ==> F 975 989 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)990 p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji+1,jj+1,1) 991 p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji+1,jj+1,1) 978 992 END DO 979 993 END DO … … 981 995 DO jj = 2, jpjm1 ! T ==> F 982 996 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) )997 p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) & 998 & + frcv(jpr_itx1)%z3(ji,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj+1,1) ) 999 p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) & 1000 & + frcv(jpr_ity1)%z3(ji,jj+1,1) + frcv(jpr_ity1)%z3(ji+1,jj+1,1) ) 987 1001 END DO 988 1002 END DO 989 1003 CASE( 'F' ) 990 p_taui(:,:) = frcv( :,:,jpr_itx1) ! F ==> F991 p_tauj(:,:) = frcv( :,:,jpr_ity1)1004 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! F ==> F 1005 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 992 1006 END SELECT 993 1007 IF( srcv(jpr_itx1)%clgrid /= 'F' ) THEN … … 998 1012 SELECT CASE ( srcv(jpr_itx1)%clgrid ) 999 1013 CASE( 'U' ) 1000 p_taui(:,:) = frcv( :,:,jpr_itx1) ! (U,V) ==> (U,V)1001 p_tauj(:,:) = frcv( :,:,jpr_ity1)1014 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! (U,V) ==> (U,V) 1015 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 1002 1016 CASE( 'F' ) 1003 1017 DO jj = 2, jpjm1 ! F ==> (U,V) 1004 1018 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) )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(jj,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) ) 1007 1021 END DO 1008 1022 END DO … … 1010 1024 DO jj = 2, jpjm1 ! T ==> (U,V) 1011 1025 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) )1026 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 1027 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1014 1028 END DO 1015 1029 END DO … … 1017 1031 DO jj = 2, jpjm1 ! I ==> (U,V) 1018 1032 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) )1033 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) ) 1034 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji ,jj+1,1) ) 1021 1035 END DO 1022 1036 END DO … … 1027 1041 END SELECT 1028 1042 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 1043 ENDIF 1036 1044 ! … … 1115 1123 1116 1124 zicefr(:,:,1) = 1.- p_frld(:,:,1) 1117 IF( lk_diaar5 ) zcptn(:,:) = rcp * t n(:,:,1)1125 IF( lk_diaar5 ) zcptn(:,:) = rcp * tsn(:,:,1,1) 1118 1126 ! 1119 1127 ! ! ========================= ! … … 1124 1132 ! ! solid precipitation - sublimation (emp_ice) 1125 1133 ! ! solid Precipitation (sprecip) 1126 SELECT CASE( TRIM( cn_rcv_emp) )1134 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1127 1135 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 precipitation1132 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)1136 pemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_rain)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1137 pemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1138 zsnow (:,:) = frcv(jpr_snow)%z3(:,:,1) 1139 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1140 IF( lk_diaar5 ) CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1141 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:,1) 1134 1142 CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average) 1135 1143 IF( lk_diaar5 ) CALL iom_put( 'hflx_evap_cea', ztmp(:,: ) * zcptn(:,:) ) ! heat flux from from evap (cell ave) 1136 1144 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)1145 pemp_tot(:,:) = p_frld(:,:,1) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:,1) * frcv(jpr_sbpr)%z3(:,:,1) 1146 pemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1147 zsnow (:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 1140 1148 END SELECT 1141 1149 psprecip(:,:) = - pemp_ice(:,:) … … 1143 1151 CALL iom_put( 'snow_ao_cea', zsnow(:,: ) * p_frld(:,:,1) ) ! Snow over ice-free ocean (cell average) 1144 1152 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)1153 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:,1) ) ! Sublimation over sea-ice (cell average) 1146 1154 ! 1147 1155 ! ! runoffs and calving (put in emp_tot) 1148 1156 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 rivers1157 pemp_tot(:,:) = pemp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 1158 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers 1159 IF( lk_diaar5 ) CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers 1152 1160 ENDIF 1153 1161 IF( srcv(jpr_cal)%laction ) THEN 1154 pemp_tot(:,:) = pemp_tot(:,:) - frcv( :,:,jpr_cal)1155 CALL iom_put( 'calving', frcv( :,:,jpr_cal) )1162 pemp_tot(:,:) = pemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1163 CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) ) 1156 1164 ENDIF 1157 1165 ! … … 1159 1167 !!gm at least should be optional... 1160 1168 !! ! 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(:,:) )1169 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 1170 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 1163 1171 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) 1164 1172 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 1165 1173 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 1166 1174 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 1167 !! frcv( :,:,jpr_rnf) = MAX( frcv(:,:,jpr_rnf), 0.e0 ) * zcumulneg1175 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 1168 1176 !! ENDIF 1169 !! pemp_tot(:,:) = pemp_tot(:,:) - frcv( :,:,jpr_rnf) ! add runoff to e-p1177 !! pemp_tot(:,:) = pemp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) ! add runoff to e-p 1170 1178 !! 1171 1179 !!gm end of internal cooking … … 1173 1181 1174 1182 ! ! ========================= ! 1175 SELECT CASE( TRIM( cn_rcv_qns ) )! non solar heat fluxes ! (qns)1183 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns) 1176 1184 ! ! ========================= ! 1185 CASE( 'oce only' ) ! the required field is directly provided 1186 pqns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1) 1177 1187 CASE( 'conservative' ) ! the required fields are directly provided 1178 pqns_tot(:,: ) = frcv( :,:,jpr_qnsmix)1179 pqns_ice(:,:,1) = frcv( :,:,jpr_qnsice)1188 pqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1189 pqns_ice(:,:,1) = frcv(jpr_qnsice)%z3(:,:,1) 1180 1190 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)1191 pqns_tot(:,: ) = p_frld(:,:,1) * frcv(jpr_qnsoce)%z3(:,:,1) + zicefr(:,:,1) * frcv(jpr_qnsice)%z3(:,:,1) 1192 pqns_ice(:,:,1) = frcv(jpr_qnsice)%z3(:,:,1) 1183 1193 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) &1194 pqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1195 pqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1196 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:,1) & 1187 1197 & + pist(:,:,1) * zicefr(:,:,1) ) ) 1188 1198 END SELECT … … 1199 1209 ! 1200 1210 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1201 ztmp(:,:) = frcv( :,:,jpr_cal) * lfus! add the latent heat of iceberg melting1211 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1202 1212 pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:) 1203 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + frcv( :,:,jpr_cal) * zcptn(:,:) ) ! heat flux from calving1213 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1204 1214 ENDIF 1205 1215 1206 1216 ! ! ========================= ! 1207 SELECT CASE( TRIM( cn_rcv_qsr ) )! solar heat fluxes ! (qsr)1217 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr) 1208 1218 ! ! ========================= ! 1219 CASE( 'oce only' ) 1220 pqsr_tot(:,: ) = frcv(jpr_qsroce)%z3(:,:,1) 1209 1221 CASE( 'conservative' ) 1210 pqsr_tot(:,: ) = frcv( :,:,jpr_qsrmix)1211 pqsr_ice(:,:,1) = frcv( :,:,jpr_qsrice)1222 pqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1223 pqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1212 1224 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)1225 pqsr_tot(:,: ) = p_frld(:,:,1) * frcv(jpr_qsroce)%z3(:,:,1) + zicefr(:,:,1) * frcv(jpr_qsrice)%z3(:,:,1) 1226 pqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1215 1227 CASE( 'mixed oce-ice' ) 1216 pqsr_tot(:,: ) = frcv( :,:,jpr_qsrmix)1228 pqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1217 1229 ! Create solar heat flux over ice using incoming solar heat flux and albedos 1218 1230 ! ( see OASIS3 user guide, 5th edition, p39 ) 1219 pqsr_ice(:,:,1) = frcv( :,:,jpr_qsrmix) * ( 1.- palbi(:,:,1) ) &1231 pqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1220 1232 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:,1) & 1221 1233 & + palbi (:,:,1) * zicefr(:,:,1) ) ) … … 1226 1238 ENDIF 1227 1239 1228 SELECT CASE( TRIM( cn_rcv_dqnsdt) )1240 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 1229 1241 CASE ('coupled') 1230 pdqns_ice(:,:,1) = frcv( :,:,jpr_dqnsdt)1242 pdqns_ice(:,:,1) = frcv(jpr_dqnsdt)%z3(:,:,1) 1231 1243 END SELECT 1232 1244 … … 1249 1261 USE wrk_nemo, ONLY: zfr_l => wrk_2d_1 ! 1. - fr_i(:,:) 1250 1262 USE wrk_nemo, ONLY: ztmp1 => wrk_2d_2 , ztmp2 => wrk_2d_3 1263 USE wrk_nemo, ONLY: ztmp3 => wrk_3d_1 , ztmp4 => wrk_3d_2 1251 1264 USE wrk_nemo, ONLY: zotx1 => wrk_2d_4 , zoty1 => wrk_2d_5 , zotz1 => wrk_2d_6 1252 1265 USE wrk_nemo, ONLY: zitx1 => wrk_2d_7 , zity1 => wrk_2d_8 , zitz1 => wrk_2d_9 … … 1254 1267 INTEGER, INTENT(in) :: kt 1255 1268 ! 1256 INTEGER :: ji, jj 1269 INTEGER :: ji, jj, jl ! dummy loop indices 1257 1270 INTEGER :: isec, info ! local integer 1258 1271 !!---------------------------------------------------------------------- 1259 1272 1260 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9) ) THEN1273 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9) .OR. wrk_in_use(3, 1,2) ) THEN 1261 1274 CALL ctl_stop('sbc_cpl_snd: requested workspace arrays are unavailable') ; RETURN 1262 1275 ENDIF … … 1269 1282 ! ! Surface temperature ! in Kelvin 1270 1283 ! ! ------------------------- ! 1271 SELECT CASE( cn_snd_temperature) 1272 CASE( 'oce only' ) ; ztmp1(:,:) = tn(:,:,1) + rt0 1273 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tn(:,:,1) + rt0 ) * zfr_l(:,:) 1274 ztmp2(:,:) = tn_ice(:,:,1) * fr_i(:,:) 1275 CASE( 'mixed oce-ice' ) ; ztmp1(:,:) = ( tn(:,:,1) + rt0 ) * zfr_l(:,:) + tn_ice(:,:,1) * fr_i(:,:) 1276 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of cn_snd_temperature' ) 1284 SELECT CASE( sn_snd_temp%cldes) 1285 CASE( 'oce only' ) ; ztmp1(:,:) = tsn(:,:,1,1) + rt0 1286 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:) 1287 SELECT CASE( sn_snd_temp%clcat ) 1288 CASE( 'yes' ) 1289 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1290 CASE( 'no' ) 1291 ztmp3(:,:,:) = 0.0 1292 DO jl=1,jpl 1293 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 1294 ENDDO 1295 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1296 END SELECT 1297 CASE( 'mixed oce-ice' ) 1298 ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:) 1299 DO jl=1,jpl 1300 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1301 ENDDO 1302 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1277 1303 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 )1304 IF( ssnd(jps_toce)%laction ) CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1305 IF( ssnd(jps_tice)%laction ) CALL cpl_prism_snd( jps_tice, isec, ztmp3, info ) 1306 IF( ssnd(jps_tmix)%laction ) CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1281 1307 ! 1282 1308 ! ! ------------------------- ! … … 1284 1310 ! ! ------------------------- ! 1285 1311 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 )1312 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1313 CALL cpl_prism_snd( jps_albice, isec, ztmp3, info ) 1288 1314 ENDIF 1289 1315 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 ) 1316 ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) 1317 DO jl=1,jpl 1318 ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 1319 ENDDO 1320 CALL cpl_prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1292 1321 ENDIF 1293 1322 ! ! ------------------------- ! 1294 1323 ! ! Ice fraction & Thickness ! 1295 1324 ! ! ------------------------- ! 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 ) 1325 ! Send ice fraction field 1326 SELECT CASE( sn_snd_thick%clcat ) 1327 CASE( 'yes' ) 1328 ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl) 1329 CASE( 'no' ) 1330 ztmp3(:,:,1) = fr_i(:,:) 1331 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1332 END SELECT 1333 IF( ssnd(jps_fice)%laction ) CALL cpl_prism_snd( jps_fice, isec, ztmp3, info ) 1334 1335 ! Send snow and ice thickness field 1336 SELECT CASE( sn_snd_thick%cldes) 1337 CASE( 'weighted ice and snow' ) 1338 SELECT CASE( sn_snd_thick%clcat ) 1339 CASE( 'yes' ) 1340 ztmp3(:,:,1:jpl) = ht_s(:,:,1:jpl) * a_i(:,:,1:jpl) 1341 ztmp4(:,:,1:jpl) = ht_i(:,:,1:jpl) * a_i(:,:,1:jpl) 1342 CASE( 'no' ) 1343 ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0 1344 DO jl=1,jpl 1345 ztmp3(:,:,1) = ztmp3(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl) 1346 ztmp4(:,:,1) = ztmp4(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl) 1347 ENDDO 1348 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1349 END SELECT 1350 CASE( 'ice and snow' ) 1351 ztmp3(:,:,1:jpl) = ht_s(:,:,1:jpl) 1352 ztmp4(:,:,1:jpl) = ht_i(:,:,1:jpl) 1353 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 1354 END SELECT 1355 IF( ssnd(jps_hsnw)%laction ) CALL cpl_prism_snd( jps_hsnw, isec, ztmp3, info ) 1356 IF( ssnd(jps_hice)%laction ) CALL cpl_prism_snd( jps_hice, isec, ztmp4, info ) 1299 1357 ! 1300 1358 #if defined key_cpl_carbon_cycle … … 1302 1360 ! ! CO2 flux from PISCES ! 1303 1361 ! ! ------------------------- ! 1304 IF( ssnd(jps_co2)%laction ) CALL cpl_prism_snd( jps_co2, isec, oce_co2, info )1362 IF( ssnd(jps_co2)%laction ) CALL cpl_prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 1305 1363 ! 1306 1364 #endif 1365 ! ! ------------------------- ! 1307 1366 IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current ! 1308 1367 ! ! ------------------------- ! … … 1316 1375 ! i-1 i i 1317 1376 ! i i+1 (for I) 1318 SELECT CASE( TRIM( cn_snd_crt(1)) )1377 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1319 1378 CASE( 'oce only' ) ! C-grid ==> T 1320 1379 DO jj = 2, jpjm1 … … 1394 1453 END SELECT 1395 1454 END SELECT 1396 CALL lbc_lnk( zotx1, 'T', -1. ) ; CALL lbc_lnk( zoty1, 'T', -1. )1455 CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 1397 1456 ! 1398 1457 ! 1399 IF( TRIM( cn_snd_crt(3)) == 'eastward-northward' ) THEN ! Rotation of the components1458 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 1400 1459 ! ! Ocean component 1401 1460 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component … … 1412 1471 ! 1413 1472 ! spherical coordinates to cartesian -> 2 components to 3 components 1414 IF( TRIM( cn_snd_crt(2)) == 'cartesian' ) THEN1473 IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN 1415 1474 ztmp1(:,:) = zotx1(:,:) ! ocean currents 1416 1475 ztmp2(:,:) = zoty1(:,:) … … 1424 1483 ENDIF 1425 1484 ! 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 grid1485 IF( ssnd(jps_ocx1)%laction ) CALL cpl_prism_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid 1486 IF( ssnd(jps_ocy1)%laction ) CALL cpl_prism_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid 1487 IF( ssnd(jps_ocz1)%laction ) CALL cpl_prism_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid 1429 1488 ! 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 grid1489 IF( ssnd(jps_ivx1)%laction ) CALL cpl_prism_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid 1490 IF( ssnd(jps_ivy1)%laction ) CALL cpl_prism_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid 1491 IF( ssnd(jps_ivz1)%laction ) CALL cpl_prism_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid 1433 1492 ! 1434 1493 ENDIF 1435 1494 ! 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')1495 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 1496 ! 1438 1497 END SUBROUTINE sbc_cpl_snd -
branches/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
r2715 r2813 16 16 USE eosbn2 ! equation of state 17 17 USE sbc_oce ! surface boundary condition: ocean fields 18 USE sbccpl 18 19 USE fldread ! read input field 19 20 USE iom ! I/O manager library … … 97 98 98 99 fr_i(:,:) = tfreez( sss_m ) * tmask(:,:,1) ! sea surface freezing temperature [Celcius] 100 #if defined key_coupled 101 a_i(:,:,1) = fr_i(:,:) 102 #endif 99 103 100 104 ! Flux and ice fraction computation
Note: See TracChangeset
for help on using the changeset viewer.
