sbccpl.F90 134 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269
  1. MODULE sbccpl
  2. !!======================================================================
  3. !! *** MODULE sbccpl ***
  4. !! Surface Boundary Condition : momentum, heat and freshwater fluxes in coupled mode
  5. !!======================================================================
  6. !! History : 2.0 ! 2007-06 (R. Redler, N. Keenlyside, W. Park) Original code split into flxmod & taumod
  7. !! 3.0 ! 2008-02 (G. Madec, C Talandier) surface module
  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
  10. !!----------------------------------------------------------------------
  11. !!----------------------------------------------------------------------
  12. !! namsbc_cpl : coupled formulation namlist
  13. !! sbc_cpl_init : initialisation of the coupled exchanges
  14. !! sbc_cpl_rcv : receive fields from the atmosphere over the ocean (ocean only)
  15. !! receive stress from the atmosphere over the ocean (ocean-ice case)
  16. !! sbc_cpl_ice_tau : receive stress from the atmosphere over ice
  17. !! sbc_cpl_ice_flx : receive fluxes from the atmosphere over ice
  18. !! sbc_cpl_snd : send fields to the atmosphere
  19. !!----------------------------------------------------------------------
  20. USE dom_oce ! ocean space and time domain
  21. USE sbc_oce ! Surface boundary condition: ocean fields
  22. USE sbc_ice ! Surface boundary condition: ice fields
  23. USE sbcapr
  24. USE sbcdcy ! surface boundary condition: diurnal cycle
  25. USE phycst ! physical constants
  26. #if defined key_lim3
  27. USE ice ! ice variables
  28. #endif
  29. #if defined key_lim2
  30. USE par_ice_2 ! ice parameters
  31. USE ice_2 ! ice variables
  32. #endif
  33. USE cpl_oasis3 ! OASIS3 coupling
  34. USE geo2ocean !
  35. USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev
  36. USE albedo !
  37. USE in_out_manager ! I/O manager
  38. USE iom ! NetCDF library
  39. USE lib_mpp ! distribued memory computing library
  40. USE wrk_nemo ! work arrays
  41. USE timing ! Timing
  42. USE lbclnk ! ocean lateral boundary conditions (or mpp link)
  43. USE eosbn2
  44. USE sbcrnf , ONLY : l_rnfcpl
  45. USE sbcisf , ONLY : l_isfcpl
  46. #if defined key_cpl_carbon_cycle
  47. USE p4zflx, ONLY : oce_co2
  48. #endif
  49. #if defined key_cice
  50. USE ice_domain_size, only: ncat
  51. #endif
  52. #if defined key_lim3
  53. USE limthd_dh ! for CALL lim_thd_snwblow
  54. #endif
  55. USE fldread ! type FLD_N, FLD
  56. IMPLICIT NONE
  57. PRIVATE
  58. PUBLIC sbc_cpl_init ! routine called by sbcmod.F90
  59. PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90
  60. PUBLIC sbc_cpl_snd ! routine called by step.F90
  61. PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim(_2).F90
  62. PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim(_2).F90
  63. PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90
  64. INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 1
  65. INTEGER, PARAMETER :: jpr_oty1 = 2 !
  66. INTEGER, PARAMETER :: jpr_otz1 = 3 !
  67. INTEGER, PARAMETER :: jpr_otx2 = 4 ! 3 atmosphere-ocean stress components on grid 2
  68. INTEGER, PARAMETER :: jpr_oty2 = 5 !
  69. INTEGER, PARAMETER :: jpr_otz2 = 6 !
  70. INTEGER, PARAMETER :: jpr_itx1 = 7 ! 3 atmosphere-ice stress components on grid 1
  71. INTEGER, PARAMETER :: jpr_ity1 = 8 !
  72. INTEGER, PARAMETER :: jpr_itz1 = 9 !
  73. INTEGER, PARAMETER :: jpr_itx2 = 10 ! 3 atmosphere-ice stress components on grid 2
  74. INTEGER, PARAMETER :: jpr_ity2 = 11 !
  75. INTEGER, PARAMETER :: jpr_itz2 = 12 !
  76. INTEGER, PARAMETER :: jpr_qsroce = 13 ! Qsr above the ocean
  77. INTEGER, PARAMETER :: jpr_qsrice = 14 ! Qsr above the ice
  78. INTEGER, PARAMETER :: jpr_qsrmix = 15
  79. INTEGER, PARAMETER :: jpr_qnsoce = 16 ! Qns above the ocean
  80. INTEGER, PARAMETER :: jpr_qnsice = 17 ! Qns above the ice
  81. INTEGER, PARAMETER :: jpr_qnsmix = 18
  82. INTEGER, PARAMETER :: jpr_rain = 19 ! total liquid precipitation (rain)
  83. INTEGER, PARAMETER :: jpr_snow = 20 ! solid precipitation over the ocean (snow)
  84. INTEGER, PARAMETER :: jpr_tevp = 21 ! total evaporation
  85. INTEGER, PARAMETER :: jpr_ievp = 22 ! solid evaporation (sublimation)
  86. INTEGER, PARAMETER :: jpr_sbpr = 23 ! sublimation - liquid precipitation - solid precipitation
  87. INTEGER, PARAMETER :: jpr_semp = 24 ! solid freshwater budget (sublimation - snow)
  88. INTEGER, PARAMETER :: jpr_oemp = 25 ! ocean freshwater budget (evap - precip)
  89. INTEGER, PARAMETER :: jpr_w10m = 26 ! 10m wind
  90. INTEGER, PARAMETER :: jpr_dqnsdt = 27 ! d(Q non solar)/d(temperature)
  91. INTEGER, PARAMETER :: jpr_rnf = 28 ! runoffs
  92. INTEGER, PARAMETER :: jpr_cal = 29 ! calving
  93. INTEGER, PARAMETER :: jpr_taum = 30 ! wind stress module
  94. INTEGER, PARAMETER :: jpr_co2 = 31
  95. INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn
  96. INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn
  97. INTEGER, PARAMETER :: jpr_sflx = 34 ! salt flux
  98. INTEGER, PARAMETER :: jpr_toce = 35 ! ocean temperature
  99. INTEGER, PARAMETER :: jpr_soce = 36 ! ocean salinity
  100. INTEGER, PARAMETER :: jpr_ocx1 = 37 ! ocean current on grid 1
  101. INTEGER, PARAMETER :: jpr_ocy1 = 38 !
  102. INTEGER, PARAMETER :: jpr_ssh = 39 ! sea surface height
  103. INTEGER, PARAMETER :: jpr_fice = 40 ! ice fraction
  104. INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness
  105. INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level
  106. INTEGER, PARAMETER :: jpr_isf = 43
  107. INTEGER, PARAMETER :: jpr_icb = 44
  108. INTEGER, PARAMETER :: jprcv = 44 ! total number of fields received
  109. INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere
  110. INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature
  111. INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature
  112. INTEGER, PARAMETER :: jps_tmix = 4 ! mixed temperature (ocean+ice)
  113. INTEGER, PARAMETER :: jps_albice = 5 ! ice albedo
  114. INTEGER, PARAMETER :: jps_albmix = 6 ! mixed albedo
  115. INTEGER, PARAMETER :: jps_hice = 7 ! ice thickness
  116. INTEGER, PARAMETER :: jps_hsnw = 8 ! snow thickness
  117. INTEGER, PARAMETER :: jps_ocx1 = 9 ! ocean current on grid 1
  118. INTEGER, PARAMETER :: jps_ocy1 = 10 !
  119. INTEGER, PARAMETER :: jps_ocz1 = 11 !
  120. INTEGER, PARAMETER :: jps_ivx1 = 12 ! ice current on grid 1
  121. INTEGER, PARAMETER :: jps_ivy1 = 13 !
  122. INTEGER, PARAMETER :: jps_ivz1 = 14 !
  123. INTEGER, PARAMETER :: jps_co2 = 15
  124. INTEGER, PARAMETER :: jps_soce = 16 ! ocean salinity
  125. INTEGER, PARAMETER :: jps_ssh = 17 ! sea surface height
  126. INTEGER, PARAMETER :: jps_qsroce = 18 ! Qsr above the ocean
  127. INTEGER, PARAMETER :: jps_qnsoce = 19 ! Qns above the ocean
  128. INTEGER, PARAMETER :: jps_oemp = 20 ! ocean freshwater budget (evap - precip)
  129. INTEGER, PARAMETER :: jps_sflx = 21 ! salt flux
  130. INTEGER, PARAMETER :: jps_otx1 = 22 ! 2 atmosphere-ocean stress components on grid 1
  131. INTEGER, PARAMETER :: jps_oty1 = 23 !
  132. INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs
  133. INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module
  134. INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling)
  135. INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl)
  136. INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level
  137. INTEGER, PARAMETER :: jpsnd = 28 ! total number of fields sended
  138. ! !!** namelist namsbc_cpl **
  139. TYPE :: FLD_C
  140. CHARACTER(len = 32) :: cldes ! desciption of the coupling strategy
  141. CHARACTER(len = 32) :: clcat ! multiple ice categories strategy
  142. CHARACTER(len = 32) :: clvref ! reference of vector ('spherical' or 'cartesian')
  143. CHARACTER(len = 32) :: clvor ! orientation of vector fields ('eastward-northward' or 'local grid')
  144. CHARACTER(len = 32) :: clvgrd ! grids on which is located the vector fields
  145. END TYPE FLD_C
  146. ! Send to the atmosphere !
  147. TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2
  148. ! Received from the atmosphere !
  149. 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
  150. TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_icb, sn_rcv_isf
  151. ! Other namelist parameters !
  152. INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
  153. LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models
  154. ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
  155. LOGICAL :: ln_force_windstress
  156. TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tau_anom ! structure of input tau anomalies (file informations, fields read)
  157. TYPE :: DYNARR
  158. REAL(wp), POINTER, DIMENSION(:,:,:) :: z3
  159. END TYPE DYNARR
  160. TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere
  161. REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky)
  162. INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument
  163. !! Substitution
  164. # include "domzgr_substitute.h90"
  165. # include "vectopt_loop_substitute.h90"
  166. !!----------------------------------------------------------------------
  167. !! NEMO/OPA 3.3 , NEMO Consortium (2010)
  168. !! $Id: sbccpl.F90 4990 2014-12-15 16:42:49Z timgraham $
  169. !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
  170. !!----------------------------------------------------------------------
  171. CONTAINS
  172. INTEGER FUNCTION sbc_cpl_alloc()
  173. !!----------------------------------------------------------------------
  174. !! *** FUNCTION sbc_cpl_alloc ***
  175. !!----------------------------------------------------------------------
  176. INTEGER :: ierr(3)
  177. !!----------------------------------------------------------------------
  178. ierr(:) = 0
  179. !
  180. ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) )
  181. #if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice
  182. ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init)
  183. #endif
  184. ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) )
  185. !
  186. sbc_cpl_alloc = MAXVAL( ierr )
  187. IF( lk_mpp ) CALL mpp_sum ( sbc_cpl_alloc )
  188. IF( sbc_cpl_alloc > 0 ) CALL ctl_warn('sbc_cpl_alloc: allocation of arrays failed')
  189. !
  190. END FUNCTION sbc_cpl_alloc
  191. SUBROUTINE sbc_cpl_init( k_ice )
  192. !!----------------------------------------------------------------------
  193. !! *** ROUTINE sbc_cpl_init ***
  194. !!
  195. !! ** Purpose : Initialisation of send and received information from
  196. !! the atmospheric component
  197. !!
  198. !! ** Method : * Read namsbc_cpl namelist
  199. !! * define the receive interface
  200. !! * define the send interface
  201. !! * initialise the OASIS coupler
  202. !!----------------------------------------------------------------------
  203. INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)
  204. !!
  205. INTEGER :: jn ! dummy loop index
  206. INTEGER :: ios ! Local integer output status for namelist read
  207. INTEGER :: inum
  208. INTEGER :: ierror ! Local integer output status for namelist read
  209. REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos
  210. !!
  211. CHARACTER(len=256) :: cn_dir
  212. TYPE(FLD_N), DIMENSION(2) :: slf_i ! array of namelist informations on the fields to read
  213. TYPE(FLD_N) :: sn_tau_anom_u ! structure of input landfast ice mask (file informations, fields read)
  214. TYPE(FLD_N) :: sn_tau_anom_v
  215. !!
  216. NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, &
  217. & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, &
  218. & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, &
  219. & sn_rcv_co2 , sn_rcv_icb , sn_rcv_isf, nn_cplmodel , ln_usecplmask, &
  220. & ln_force_windstress , cn_dir , sn_tau_anom_u , sn_tau_anom_v
  221. !!---------------------------------------------------------------------
  222. !
  223. IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init')
  224. !
  225. CALL wrk_alloc( jpi,jpj, zacs, zaos )
  226. ! ================================ !
  227. ! Namelist informations !
  228. ! ================================ !
  229. REWIND( numnam_ref ) ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling
  230. READ ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901)
  231. 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp )
  232. REWIND( numnam_cfg ) ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling
  233. READ ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 )
  234. 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp )
  235. IF(lwm) WRITE ( numond, namsbc_cpl )
  236. IF(lwp) THEN ! control print
  237. WRITE(numout,*)
  238. WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist '
  239. WRITE(numout,*)'~~~~~~~~~~~~'
  240. ENDIF
  241. IF( lwp .AND. ln_cpl ) THEN ! control print
  242. WRITE(numout,*)' received fields (mutiple ice categogies)'
  243. WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')'
  244. WRITE(numout,*)' stress module = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')'
  245. WRITE(numout,*)' surface stress = ', TRIM(sn_rcv_tau%cldes ), ' (', TRIM(sn_rcv_tau%clcat ), ')'
  246. WRITE(numout,*)' - referential = ', sn_rcv_tau%clvref
  247. WRITE(numout,*)' - orientation = ', sn_rcv_tau%clvor
  248. WRITE(numout,*)' - mesh = ', sn_rcv_tau%clvgrd
  249. WRITE(numout,*)' non-solar heat flux sensitivity = ', TRIM(sn_rcv_dqnsdt%cldes), ' (', TRIM(sn_rcv_dqnsdt%clcat), ')'
  250. WRITE(numout,*)' solar heat flux = ', TRIM(sn_rcv_qsr%cldes ), ' (', TRIM(sn_rcv_qsr%clcat ), ')'
  251. WRITE(numout,*)' non-solar heat flux = ', TRIM(sn_rcv_qns%cldes ), ' (', TRIM(sn_rcv_qns%clcat ), ')'
  252. WRITE(numout,*)' freshwater budget = ', TRIM(sn_rcv_emp%cldes ), ' (', TRIM(sn_rcv_emp%clcat ), ')'
  253. WRITE(numout,*)' runoffs = ', TRIM(sn_rcv_rnf%cldes ), ' (', TRIM(sn_rcv_rnf%clcat ), ')'
  254. WRITE(numout,*)' calving = ', TRIM(sn_rcv_cal%cldes ), ' (', TRIM(sn_rcv_cal%clcat ), ')'
  255. WRITE(numout,*)' iceberg = ', TRIM(sn_rcv_icb%cldes ), ' (', TRIM(sn_rcv_icb%clcat ), ')'
  256. WRITE(numout,*)' ice shelf = ', TRIM(sn_rcv_isf%cldes ), ' (', TRIM(sn_rcv_isf%clcat ), ')'
  257. WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')'
  258. WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')'
  259. WRITE(numout,*)' sent fields (multiple ice categories)'
  260. WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')'
  261. WRITE(numout,*)' albedo = ', TRIM(sn_snd_alb%cldes ), ' (', TRIM(sn_snd_alb%clcat ), ')'
  262. WRITE(numout,*)' ice/snow thickness = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')'
  263. WRITE(numout,*)' surface current = ', TRIM(sn_snd_crt%cldes ), ' (', TRIM(sn_snd_crt%clcat ), ')'
  264. WRITE(numout,*)' - referential = ', sn_snd_crt%clvref
  265. WRITE(numout,*)' - orientation = ', sn_snd_crt%clvor
  266. WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd
  267. WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')'
  268. WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel
  269. WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask
  270. WRITE(numout,*)' ln_force_windstress = ', ln_force_windstress
  271. IF ( ln_force_windstress ) THEN
  272. WRITE(numout,*)' path to anomalies files = ', TRIM(cn_dir)
  273. WRITE(numout,*)' type of anomalies files = ', TRIM(sn_tau_anom_u%cltype)
  274. WRITE(numout,*)' freq. of anomalies files = ', sn_tau_anom_u%nfreqh
  275. ENDIF
  276. ENDIF
  277. ! ! allocate sbccpl arrays
  278. IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )
  279. ! ================================ !
  280. ! Define the receive interface !
  281. ! ================================ !
  282. nrcvinfo(:) = OASIS_idle ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress
  283. ! for each field: define the OASIS name (srcv(:)%clname)
  284. ! define receive or not from the namelist parameters (srcv(:)%laction)
  285. ! define the north fold type of lbc (srcv(:)%nsgn)
  286. ! default definitions of srcv
  287. srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1
  288. ! ! ------------------------- !
  289. ! ! ice and ocean wind stress !
  290. ! ! ------------------------- !
  291. ! ! Name
  292. srcv(jpr_otx1)%clname = 'O_OTaux1' ! 1st ocean component on grid ONE (T or U)
  293. srcv(jpr_oty1)%clname = 'O_OTauy1' ! 2nd - - - -
  294. srcv(jpr_otz1)%clname = 'O_OTauz1' ! 3rd - - - -
  295. srcv(jpr_otx2)%clname = 'O_OTaux2' ! 1st ocean component on grid TWO (V)
  296. srcv(jpr_oty2)%clname = 'O_OTauy2' ! 2nd - - - -
  297. srcv(jpr_otz2)%clname = 'O_OTauz2' ! 3rd - - - -
  298. !
  299. srcv(jpr_itx1)%clname = 'O_ITaux1' ! 1st ice component on grid ONE (T, F, I or U)
  300. srcv(jpr_ity1)%clname = 'O_ITauy1' ! 2nd - - - -
  301. srcv(jpr_itz1)%clname = 'O_ITauz1' ! 3rd - - - -
  302. srcv(jpr_itx2)%clname = 'O_ITaux2' ! 1st ice component on grid TWO (V)
  303. srcv(jpr_ity2)%clname = 'O_ITauy2' ! 2nd - - - -
  304. srcv(jpr_itz2)%clname = 'O_ITauz2' ! 3rd - - - -
  305. !
  306. ! Vectors: change of sign at north fold ONLY if on the local grid
  307. IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1.
  308. ! ! Set grid and action
  309. SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) ) ! 'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V'
  310. CASE( 'T' )
  311. srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
  312. srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
  313. srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
  314. CASE( 'U,V' )
  315. srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
  316. srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
  317. srcv(jpr_itx1:jpr_itz1)%clgrid = 'U' ! ice components given at U-point
  318. srcv(jpr_itx2:jpr_itz2)%clgrid = 'V' ! and V-point
  319. srcv(jpr_otx1:jpr_itz2)%laction = .TRUE. ! receive oce and ice components on both grid 1 & 2
  320. CASE( 'U,V,T' )
  321. srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
  322. srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
  323. srcv(jpr_itx1:jpr_itz1)%clgrid = 'T' ! ice components given at T-point
  324. srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
  325. srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
  326. CASE( 'U,V,I' )
  327. srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
  328. srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
  329. srcv(jpr_itx1:jpr_itz1)%clgrid = 'I' ! ice components given at I-point
  330. srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
  331. srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
  332. CASE( 'U,V,F' )
  333. srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
  334. srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
  335. srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point
  336. srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
  337. srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
  338. CASE( 'T,I' )
  339. srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
  340. srcv(jpr_itx1:jpr_itz1)%clgrid = 'I' ! ice components given at I-point
  341. srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
  342. srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
  343. CASE( 'T,F' )
  344. srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
  345. srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point
  346. srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
  347. srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
  348. CASE( 'T,U,V' )
  349. srcv(jpr_otx1:jpr_otz1)%clgrid = 'T' ! oce components given at T-point
  350. srcv(jpr_itx1:jpr_itz1)%clgrid = 'U' ! ice components given at U-point
  351. srcv(jpr_itx2:jpr_itz2)%clgrid = 'V' ! and V-point
  352. srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1 only
  353. srcv(jpr_itx1:jpr_itz2)%laction = .TRUE. ! receive ice components on grid 1 & 2
  354. CASE default
  355. CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' )
  356. END SELECT
  357. !
  358. IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' ) & ! spherical: 3rd component not received
  359. & srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE.
  360. !
  361. IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) THEN ! already on local grid -> no need of the second grid
  362. srcv(jpr_otx2:jpr_otz2)%laction = .FALSE.
  363. srcv(jpr_itx2:jpr_itz2)%laction = .FALSE.
  364. srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid ! not needed but cleaner...
  365. srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid ! not needed but cleaner...
  366. ENDIF
  367. !
  368. IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used
  369. srcv(jpr_itx1:jpr_itz2)%laction = .FALSE. ! ice components not received
  370. srcv(jpr_itx1)%clgrid = 'U' ! ocean stress used after its transformation
  371. srcv(jpr_ity1)%clgrid = 'V' ! i.e. it is always at U- & V-points for i- & j-comp. resp.
  372. ENDIF
  373. ! ! ------------------------- !
  374. ! ! freshwater budget ! E-P
  375. ! ! ------------------------- !
  376. ! we suppose that atmosphere modele do not make the difference between precipiration (liquide or solid)
  377. ! over ice of free ocean within the same atmospheric cell.cd
  378. srcv(jpr_rain)%clname = 'OTotRain' ! Rain = liquid precipitation
  379. srcv(jpr_snow)%clname = 'OTotSnow' ! Snow = solid precipitation
  380. srcv(jpr_tevp)%clname = 'OTotEvap' ! total evaporation (over oce + ice sublimation)
  381. srcv(jpr_ievp)%clname = 'OIceEvap' ! evaporation over ice = sublimation
  382. srcv(jpr_sbpr)%clname = 'OSubMPre' ! sublimation - liquid precipitation - solid precipitation
  383. srcv(jpr_semp)%clname = 'OISubMSn' ! ice solid water budget = sublimation - solid precipitation
  384. srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip
  385. SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
  386. CASE( 'none' ) ! nothing to do
  387. CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE.
  388. CASE( 'conservative' )
  389. srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE.
  390. IF ( k_ice <= 1 ) srcv(jpr_ievp)%laction = .FALSE.
  391. CASE( 'oce and ice' ) ; srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE.
  392. CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' )
  393. END SELECT
  394. ! ! ---------------------------------------------------- !
  395. ! ! Runoffs, Calving, Iceberg, Iceshelf cavities !
  396. ! ! ---------------------------------------------------- !
  397. srcv(jpr_rnf )%clname = 'O_Runoff'
  398. IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN
  399. srcv(jpr_rnf)%laction = .TRUE.
  400. l_rnfcpl = .TRUE. ! -> no need to read runoffs in sbcrnf
  401. ln_rnf = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas
  402. IF(lwp) WRITE(numout,*)
  403. IF(lwp) WRITE(numout,*) ' runoffs received from oasis -> force ln_rnf = ', ln_rnf
  404. ENDIF
  405. !
  406. srcv(jpr_cal)%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE.
  407. srcv(jpr_isf)%clname = 'OIcshelf' ; IF( TRIM( sn_rcv_isf%cldes) == 'coupled' ) srcv(jpr_isf)%laction = .TRUE.
  408. srcv(jpr_icb)%clname = 'OIceberg' ; IF( TRIM( sn_rcv_icb%cldes) == 'coupled' ) srcv(jpr_icb)%laction = .TRUE.
  409. IF( srcv(jpr_isf)%laction .AND. nn_isf > 0 ) THEN
  410. l_isfcpl = .TRUE. ! -> no need to read isf in sbcisf
  411. IF(lwp) WRITE(numout,*)
  412. IF(lwp) WRITE(numout,*) ' iceshelf received from oasis '
  413. ENDIF
  414. ! ! ------------------------- !
  415. ! ! non solar radiation ! Qns
  416. ! ! ------------------------- !
  417. srcv(jpr_qnsoce)%clname = 'O_QnsOce'
  418. srcv(jpr_qnsice)%clname = 'O_QnsIce'
  419. srcv(jpr_qnsmix)%clname = 'O_QnsMix'
  420. SELECT CASE( TRIM( sn_rcv_qns%cldes ) )
  421. CASE( 'none' ) ! nothing to do
  422. CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE.
  423. CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE.
  424. CASE( 'oce and ice' ) ; srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE.
  425. CASE( 'mixed oce-ice' ) ; srcv( jpr_qnsmix )%laction = .TRUE.
  426. CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' )
  427. END SELECT
  428. IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) &
  429. CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' )
  430. ! ! ------------------------- !
  431. ! ! solar radiation ! Qsr
  432. ! ! ------------------------- !
  433. srcv(jpr_qsroce)%clname = 'O_QsrOce'
  434. srcv(jpr_qsrice)%clname = 'O_QsrIce'
  435. srcv(jpr_qsrmix)%clname = 'O_QsrMix'
  436. SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )
  437. CASE( 'none' ) ! nothing to do
  438. CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE.
  439. CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE.
  440. CASE( 'oce and ice' ) ; srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE.
  441. CASE( 'mixed oce-ice' ) ; srcv( jpr_qsrmix )%laction = .TRUE.
  442. CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' )
  443. END SELECT
  444. IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) &
  445. CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' )
  446. ! ! ------------------------- !
  447. ! ! non solar sensitivity ! d(Qns)/d(T)
  448. ! ! ------------------------- !
  449. srcv(jpr_dqnsdt)%clname = 'O_dQnsdT'
  450. IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' ) srcv(jpr_dqnsdt)%laction = .TRUE.
  451. !
  452. ! non solar sensitivity mandatory for LIM ice model
  453. IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) &
  454. CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' )
  455. ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique
  456. IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) &
  457. CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' )
  458. ! ! ------------------------- !
  459. ! ! 10m wind module !
  460. ! ! ------------------------- !
  461. srcv(jpr_w10m)%clname = 'O_Wind10' ; IF( TRIM(sn_rcv_w10m%cldes ) == 'coupled' ) srcv(jpr_w10m)%laction = .TRUE.
  462. !
  463. ! ! ------------------------- !
  464. ! ! wind stress module !
  465. ! ! ------------------------- !
  466. srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE.
  467. lhftau = srcv(jpr_taum)%laction
  468. ! ! ------------------------- !
  469. ! ! Atmospheric CO2 !
  470. ! ! ------------------------- !
  471. srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE.
  472. ! ! ------------------------- !
  473. ! ! topmelt and botmelt !
  474. ! ! ------------------------- !
  475. srcv(jpr_topm )%clname = 'OTopMlt'
  476. srcv(jpr_botm )%clname = 'OBotMlt'
  477. IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN
  478. IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN
  479. srcv(jpr_topm:jpr_botm)%nct = jpl
  480. ELSE
  481. CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' )
  482. ENDIF
  483. srcv(jpr_topm:jpr_botm)%laction = .TRUE.
  484. ENDIF
  485. ! ! ------------------------------- !
  486. ! ! OPA-SAS coupling - rcv by opa !
  487. ! ! ------------------------------- !
  488. srcv(jpr_sflx)%clname = 'O_SFLX'
  489. srcv(jpr_fice)%clname = 'RIceFrc'
  490. !
  491. IF( nn_components == jp_iam_opa ) THEN ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS)
  492. srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
  493. srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling
  494. srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling
  495. srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE.
  496. srcv(jpr_otx1)%clgrid = 'U' ! oce components given at U-point
  497. srcv(jpr_oty1)%clgrid = 'V' ! and V-point
  498. ! Vectors: change of sign at north fold ONLY if on the local grid
  499. srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1.
  500. sn_rcv_tau%clvgrd = 'U,V'
  501. sn_rcv_tau%clvor = 'local grid'
  502. sn_rcv_tau%clvref = 'spherical'
  503. sn_rcv_emp%cldes = 'oce only'
  504. !
  505. IF(lwp) THEN ! control print
  506. WRITE(numout,*)
  507. WRITE(numout,*)' Special conditions for SAS-OPA coupling '
  508. WRITE(numout,*)' OPA component '
  509. WRITE(numout,*)
  510. WRITE(numout,*)' received fields from SAS component '
  511. WRITE(numout,*)' ice cover '
  512. WRITE(numout,*)' oce only EMP '
  513. WRITE(numout,*)' salt flux '
  514. WRITE(numout,*)' mixed oce-ice solar flux '
  515. WRITE(numout,*)' mixed oce-ice non solar flux '
  516. WRITE(numout,*)' wind stress U,V on local grid and sperical coordinates '
  517. WRITE(numout,*)' wind stress module'
  518. WRITE(numout,*)
  519. ENDIF
  520. ENDIF
  521. ! ! -------------------------------- !
  522. ! ! OPA-SAS coupling - rcv by sas !
  523. ! ! -------------------------------- !
  524. srcv(jpr_toce )%clname = 'I_SSTSST'
  525. srcv(jpr_soce )%clname = 'I_SSSal'
  526. srcv(jpr_ocx1 )%clname = 'I_OCurx1'
  527. srcv(jpr_ocy1 )%clname = 'I_OCury1'
  528. srcv(jpr_ssh )%clname = 'I_SSHght'
  529. srcv(jpr_e3t1st)%clname = 'I_E3T1st'
  530. srcv(jpr_fraqsr)%clname = 'I_FraQsr'
  531. !
  532. IF( nn_components == jp_iam_sas ) THEN
  533. IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
  534. IF( .NOT. ln_cpl ) srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling
  535. IF( .NOT. ln_cpl ) srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling
  536. srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE.
  537. srcv( jpr_e3t1st )%laction = lk_vvl
  538. srcv(jpr_ocx1)%clgrid = 'U' ! oce components given at U-point
  539. srcv(jpr_ocy1)%clgrid = 'V' ! and V-point
  540. ! Vectors: change of sign at north fold ONLY if on the local grid
  541. srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1.
  542. ! Change first letter to couple with atmosphere if already coupled OPA
  543. ! this is nedeed as each variable name used in the namcouple must be unique:
  544. ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere
  545. DO jn = 1, jprcv
  546. IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname))
  547. END DO
  548. !
  549. IF(lwp) THEN ! control print
  550. WRITE(numout,*)
  551. WRITE(numout,*)' Special conditions for SAS-OPA coupling '
  552. WRITE(numout,*)' SAS component '
  553. WRITE(numout,*)
  554. IF( .NOT. ln_cpl ) THEN
  555. WRITE(numout,*)' received fields from OPA component '
  556. ELSE
  557. WRITE(numout,*)' Additional received fields from OPA component : '
  558. ENDIF
  559. WRITE(numout,*)' sea surface temperature (Celcius) '
  560. WRITE(numout,*)' sea surface salinity '
  561. WRITE(numout,*)' surface currents '
  562. WRITE(numout,*)' sea surface height '
  563. WRITE(numout,*)' thickness of first ocean T level '
  564. WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level'
  565. WRITE(numout,*)
  566. ENDIF
  567. ENDIF
  568. ! =================================================== !
  569. ! Allocate all parts of frcv used for received fields !
  570. ! =================================================== !
  571. DO jn = 1, jprcv
  572. IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
  573. END DO
  574. ! Allocate taum part of frcv which is used even when not received as coupling field
  575. IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
  576. ! Allocate w10m part of frcv which is used even when not received as coupling field
  577. IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )
  578. ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field
  579. IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )
  580. IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )
  581. ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.
  582. IF( k_ice /= 0 ) THEN
  583. IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )
  584. IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
  585. END IF
  586. ! ================================ !
  587. ! Define the send interface !
  588. ! ================================ !
  589. ! for each field: define the OASIS name (ssnd(:)%clname)
  590. ! define send or not from the namelist parameters (ssnd(:)%laction)
  591. ! define the north fold type of lbc (ssnd(:)%nsgn)
  592. ! default definitions of nsnd
  593. ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1
  594. ! ! ------------------------- !
  595. ! ! Surface temperature !
  596. ! ! ------------------------- !
  597. ssnd(jps_toce)%clname = 'O_SSTSST'
  598. ssnd(jps_tice)%clname = 'O_TepIce'
  599. ssnd(jps_tmix)%clname = 'O_TepMix'
  600. SELECT CASE( TRIM( sn_snd_temp%cldes ) )
  601. CASE( 'none' ) ! nothing to do
  602. CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE.
  603. CASE( 'oce and ice' , 'weighted oce and ice' )
  604. ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE.
  605. IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl
  606. CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE.
  607. CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' )
  608. END SELECT
  609. ! ! ------------------------- !
  610. ! ! Albedo !
  611. ! ! ------------------------- !
  612. ssnd(jps_albice)%clname = 'O_AlbIce'
  613. ssnd(jps_albmix)%clname = 'O_AlbMix'
  614. SELECT CASE( TRIM( sn_snd_alb%cldes ) )
  615. CASE( 'none' ) ! nothing to do
  616. CASE( 'ice' , 'weighted ice' ) ; ssnd(jps_albice)%laction = .TRUE.
  617. CASE( 'mixed oce-ice' ) ; ssnd(jps_albmix)%laction = .TRUE.
  618. CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' )
  619. END SELECT
  620. !
  621. ! Need to calculate oceanic albedo if
  622. ! 1. sending mixed oce-ice or ice albedo or
  623. ! 2. receiving mixed oce-ice solar radiation
  624. IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' &
  625. & .OR. TRIM ( sn_snd_alb%cldes ) == 'ice' &
  626. & .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN
  627. CALL albedo_oce( zaos, zacs )
  628. ! Due to lack of information on nebulosity : mean clear/overcast sky
  629. albedo_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5
  630. ENDIF
  631. ! ! ------------------------- !
  632. ! ! Ice fraction & Thickness !
  633. ! ! ------------------------- !
  634. ssnd(jps_fice)%clname = 'OIceFrc'
  635. ssnd(jps_hice)%clname = 'OIceTck'
  636. ssnd(jps_hsnw)%clname = 'OSnwTck'
  637. IF( k_ice /= 0 ) THEN
  638. ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case)
  639. ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now
  640. IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl
  641. ENDIF
  642. SELECT CASE ( TRIM( sn_snd_thick%cldes ) )
  643. CASE( 'none' ) ! nothing to do
  644. CASE( 'ice and snow' )
  645. ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
  646. IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
  647. ssnd(jps_hice:jps_hsnw)%nct = jpl
  648. ENDIF
  649. CASE ( 'weighted ice and snow' )
  650. ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
  651. IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = jpl
  652. CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' )
  653. END SELECT
  654. ! ! ------------------------- !
  655. ! ! Surface current !
  656. ! ! ------------------------- !
  657. ! ocean currents ! ice velocities
  658. ssnd(jps_ocx1)%clname = 'O_OCurx1' ; ssnd(jps_ivx1)%clname = 'O_IVelx1'
  659. ssnd(jps_ocy1)%clname = 'O_OCury1' ; ssnd(jps_ivy1)%clname = 'O_IVely1'
  660. ssnd(jps_ocz1)%clname = 'O_OCurz1' ; ssnd(jps_ivz1)%clname = 'O_IVelz1'
  661. !
  662. ssnd(jps_ocx1:jps_ivz1)%nsgn = -1. ! vectors: change of the sign at the north fold
  663. IF( sn_snd_crt%clvgrd == 'U,V' ) THEN
  664. ssnd(jps_ocx1)%clgrid = 'U' ; ssnd(jps_ocy1)%clgrid = 'V'
  665. ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN
  666. CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' )
  667. ssnd(jps_ocx1:jps_ivz1)%clgrid = 'T' ! all oce and ice components on the same unique grid
  668. ENDIF
  669. ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE. ! default: all are send
  670. IF( TRIM( sn_snd_crt%clvref ) == 'spherical' ) ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE.
  671. IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) ssnd(jps_ocx1:jps_ivz1)%nsgn = 1.
  672. SELECT CASE( TRIM( sn_snd_crt%cldes ) )
  673. CASE( 'none' ) ; ssnd(jps_ocx1:jps_ivz1)%laction = .FALSE.
  674. CASE( 'oce only' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
  675. CASE( 'weighted oce and ice' ) ! nothing to do
  676. CASE( 'mixed oce-ice' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
  677. CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crt%cldes' )
  678. END SELECT
  679. ! ! ------------------------- !
  680. ! ! CO2 flux !
  681. ! ! ------------------------- !
  682. ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE.
  683. ! ! ------------------------------- !
  684. ! ! OPA-SAS coupling - snd by opa !
  685. ! ! ------------------------------- !
  686. ssnd(jps_ssh )%clname = 'O_SSHght'
  687. ssnd(jps_soce )%clname = 'O_SSSal'
  688. ssnd(jps_e3t1st)%clname = 'O_E3T1st'
  689. ssnd(jps_fraqsr)%clname = 'O_FraQsr'
  690. !
  691. IF( nn_components == jp_iam_opa ) THEN
  692. ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
  693. ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE.
  694. ssnd( jps_e3t1st )%laction = lk_vvl
  695. ! vector definition: not used but cleaner...
  696. ssnd(jps_ocx1)%clgrid = 'U' ! oce components given at U-point
  697. ssnd(jps_ocy1)%clgrid = 'V' ! and V-point
  698. sn_snd_crt%clvgrd = 'U,V'
  699. sn_snd_crt%clvor = 'local grid'
  700. sn_snd_crt%clvref = 'spherical'
  701. !
  702. IF(lwp) THEN ! control print
  703. WRITE(numout,*)
  704. WRITE(numout,*)' sent fields to SAS component '
  705. WRITE(numout,*)' sea surface temperature (T before, Celcius) '
  706. WRITE(numout,*)' sea surface salinity '
  707. WRITE(numout,*)' surface currents U,V on local grid and spherical coordinates'
  708. WRITE(numout,*)' sea surface height '
  709. WRITE(numout,*)' thickness of first ocean T level '
  710. WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level'
  711. WRITE(numout,*)
  712. ENDIF
  713. ENDIF
  714. ! ! ------------------------------- !
  715. ! ! OPA-SAS coupling - snd by sas !
  716. ! ! ------------------------------- !
  717. ssnd(jps_sflx )%clname = 'I_SFLX'
  718. ssnd(jps_fice2 )%clname = 'IIceFrc'
  719. ssnd(jps_qsroce)%clname = 'I_QsrOce'
  720. ssnd(jps_qnsoce)%clname = 'I_QnsOce'
  721. ssnd(jps_oemp )%clname = 'IOEvaMPr'
  722. ssnd(jps_otx1 )%clname = 'I_OTaux1'
  723. ssnd(jps_oty1 )%clname = 'I_OTauy1'
  724. ssnd(jps_rnf )%clname = 'I_Runoff'
  725. ssnd(jps_taum )%clname = 'I_TauMod'
  726. !
  727. IF( nn_components == jp_iam_sas ) THEN
  728. IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
  729. ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE.
  730. !
  731. ! Change first letter to couple with atmosphere if already coupled with sea_ice
  732. ! this is nedeed as each variable name used in the namcouple must be unique:
  733. ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere
  734. DO jn = 1, jpsnd
  735. IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname))
  736. END DO
  737. !
  738. IF(lwp) THEN ! control print
  739. WRITE(numout,*)
  740. IF( .NOT. ln_cpl ) THEN
  741. WRITE(numout,*)' sent fields to OPA component '
  742. ELSE
  743. WRITE(numout,*)' Additional sent fields to OPA component : '
  744. ENDIF
  745. WRITE(numout,*)' ice cover '
  746. WRITE(numout,*)' oce only EMP '
  747. WRITE(numout,*)' salt flux '
  748. WRITE(numout,*)' mixed oce-ice solar flux '
  749. WRITE(numout,*)' mixed oce-ice non solar flux '
  750. WRITE(numout,*)' wind stress U,V components'
  751. WRITE(numout,*)' wind stress module'
  752. ENDIF
  753. ENDIF
  754. IF ( ln_force_windstress ) THEN
  755. slf_i(1) = sn_tau_anom_u ; slf_i(2) = sn_tau_anom_v
  756. ALLOCATE( sf_tau_anom(2), STAT=ierror )
  757. IF( ierror > 0 ) THEN
  758. CALL ctl_stop( 'sbc_cpl_init: unable to allocate sf_tau_anom structure' ) ; RETURN
  759. ENDIF
  760. DO jn= 1, 2
  761. ALLOCATE( sf_tau_anom(jn)%fnow(jpi,jpj,1) )
  762. IF( slf_i(jn)%ln_tint ) ALLOCATE( sf_tau_anom(jn)%fdta(jpi,jpj,1,2) )
  763. IF(lwp) WRITE(numout,*) jpi,jpj
  764. IF( TRIM(slf_i(jn)%clname) == 'NOT USED' ) sf_tau_anom(jn)%fnow(:,:,1) = 0._wp ! not used field (set to 0)
  765. END DO
  766. !
  767. CALL fld_fill( sf_tau_anom, slf_i, cn_dir, 'sbc_cpl_init', &
  768. & 'tau from anomalies data', 'sbccpl' )
  769. ENDIF
  770. !
  771. ! ================================ !
  772. ! initialisation of the coupler !
  773. ! ================================ !
  774. CALL cpl_define(jprcv, jpsnd, nn_cplmodel)
  775. IF (ln_usecplmask) THEN
  776. xcplmask(:,:,:) = 0.
  777. CALL iom_open( 'cplmask', inum )
  778. CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel), &
  779. & kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) )
  780. CALL iom_close( inum )
  781. ELSE
  782. xcplmask(:,:,:) = 1.
  783. ENDIF
  784. xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 )
  785. !
  786. ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' )
  787. IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 ) &
  788. & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
  789. ncpl_qsr_freq = 86400 / ncpl_qsr_freq
  790. CALL wrk_dealloc( jpi,jpj, zacs, zaos )
  791. !
  792. IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_init')
  793. !
  794. END SUBROUTINE sbc_cpl_init
  795. SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )
  796. !!----------------------------------------------------------------------
  797. !! *** ROUTINE sbc_cpl_rcv ***
  798. !!
  799. !! ** Purpose : provide the stress over the ocean and, if no sea-ice,
  800. !! provide the ocean heat and freshwater fluxes.
  801. !!
  802. !! ** Method : - Receive all the atmospheric fields (stored in frcv array). called at each time step.
  803. !! OASIS controls if there is something do receive or not. nrcvinfo contains the info
  804. !! to know if the field was really received or not
  805. !!
  806. !! --> If ocean stress was really received:
  807. !!
  808. !! - transform the received ocean stress vector from the received
  809. !! referential and grid into an atmosphere-ocean stress in
  810. !! the (i,j) ocean referencial and at the ocean velocity point.
  811. !! The received stress are :
  812. !! - defined by 3 components (if cartesian coordinate)
  813. !! or by 2 components (if spherical)
  814. !! - oriented along geographical coordinate (if eastward-northward)
  815. !! or along the local grid coordinate (if local grid)
  816. !! - given at U- and V-point, resp. if received on 2 grids
  817. !! or at T-point if received on 1 grid
  818. !! Therefore and if necessary, they are successively
  819. !! processed in order to obtain them
  820. !! first as 2 components on the sphere
  821. !! second as 2 components oriented along the local grid
  822. !! third as 2 components on the U,V grid
  823. !!
  824. !! -->
  825. !!
  826. !! - In 'ocean only' case, non solar and solar ocean heat fluxes
  827. !! and total ocean freshwater fluxes
  828. !!
  829. !! ** Method : receive all fields from the atmosphere and transform
  830. !! them into ocean surface boundary condition fields
  831. !!
  832. !! ** Action : update utau, vtau ocean stress at U,V grid
  833. !! taum wind stress module at T-point
  834. !! wndm wind speed module at T-point over free ocean or leads in presence of sea-ice
  835. !! qns non solar heat fluxes including emp heat content (ocean only case)
  836. !! and the latent heat flux of solid precip. melting
  837. !! qsr solar ocean heat fluxes (ocean only case)
  838. !! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case)
  839. !!----------------------------------------------------------------------
  840. INTEGER, INTENT(in) :: kt ! ocean model time step index
  841. INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation
  842. INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)
  843. !!
  844. LOGICAL :: llnewtx, llnewtau ! update wind stress components and module??
  845. INTEGER :: ji, jj, jn ! dummy loop indices
  846. INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000)
  847. REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars
  848. REAL(wp) :: zcoef ! temporary scalar
  849. REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3
  850. REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient
  851. REAL(wp) :: zzx, zzy ! temporary variables
  852. REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr
  853. !!----------------------------------------------------------------------
  854. !
  855. IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv')
  856. !
  857. CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )
  858. !
  859. IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0)
  860. !
  861. ! ! ======================================================= !
  862. ! ! Receive all the atmos. fields (including ice information)
  863. ! ! ======================================================= !
  864. isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges
  865. DO jn = 1, jprcv ! received fields sent by the atmosphere
  866. IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )
  867. END DO
  868. ! ! ========================= !
  869. IF( srcv(jpr_otx1)%laction ) THEN ! ocean stress components !
  870. ! ! ========================= !
  871. ! define frcv(jpr_otx1)%z3(:,:,1) and frcv(jpr_oty1)%z3(:,:,1): stress at U/V point along model grid
  872. ! => need to be done only when we receive the field
  873. !
  874. ! ocean stress components (jpr_otx1) : T
  875. ! oasis_rcv: nrcvinfo 1
  876. ! oasis_rcv: clvref spherical
  877. ! oasis_rcv: clvor eastward-northward
  878. ! oasis_rcv: clgrid U
  879. !
  880. IF( nrcvinfo(jpr_otx1) == OASIS_Rcv ) THEN
  881. !
  882. IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere
  883. ! ! (cartesian to spherical -> 3 to 2 components)
  884. !
  885. CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1), &
  886. & srcv(jpr_otx1)%clgrid, ztx, zty )
  887. frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid
  888. frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid
  889. !
  890. IF( srcv(jpr_otx2)%laction ) THEN
  891. CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1), &
  892. & srcv(jpr_otx2)%clgrid, ztx, zty )
  893. frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid
  894. frcv(jpr_oty2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid
  895. ENDIF
  896. !
  897. ENDIF
  898. !
  899. IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid
  900. ! ! (geographical to local grid -> rotate the components)
  901. CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )
  902. IF( srcv(jpr_otx2)%laction ) THEN
  903. CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )
  904. ELSE
  905. CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )
  906. ENDIF
  907. frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid
  908. frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid
  909. ENDIF
  910. !
  911. IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN
  912. DO jj = 2, jpjm1 ! T ==> (U,V)
  913. DO ji = fs_2, fs_jpim1 ! vector opt.
  914. frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) )
  915. frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) )
  916. END DO
  917. END DO
  918. CALL lbc_lnk( frcv(jpr_otx1)%z3(:,:,1), 'U', -1. ) ; CALL lbc_lnk( frcv(jpr_oty1)%z3(:,:,1), 'V', -1. )
  919. ENDIF
  920. llnewtx = .TRUE.
  921. ELSE
  922. llnewtx = .FALSE.
  923. ENDIF
  924. !
  925. IF( ln_force_windstress ) THEN
  926. CALL fld_read( kt, k_fsbc, sf_tau_anom )
  927. DO jj = 1, jpj
  928. DO ji = 1, jpi
  929. frcv(jpr_otx1)%z3(ji,jj,1) = frcv(jpr_otx1)%z3(ji,jj,1) + sf_tau_anom(1)%fnow(ji,jj,1)
  930. frcv(jpr_oty1)%z3(ji,jj,1) = frcv(jpr_oty1)%z3(ji,jj,1) + sf_tau_anom(2)%fnow(ji,jj,1)
  931. END DO
  932. END DO
  933. llnewtx = .TRUE.
  934. ENDIF
  935. ! ! ========================= !
  936. ELSE ! No dynamical coupling !
  937. ! ! ========================= !
  938. frcv(jpr_otx1)%z3(:,:,1) = 0.e0 ! here simply set to zero
  939. frcv(jpr_oty1)%z3(:,:,1) = 0.e0 ! an external read in a file can be added instead
  940. !
  941. IF( ln_force_windstress ) THEN
  942. DO jj = 1, jpj
  943. DO ji = 1, jpi
  944. frcv(jpr_otx1)%z3(ji,jj,1) = sf_tau_anom(1)%fnow(ji,jj,1)
  945. frcv(jpr_oty1)%z3(ji,jj,1) = sf_tau_anom(2)%fnow(ji,jj,1)
  946. END DO
  947. END DO
  948. ENDIF
  949. llnewtx = .TRUE.
  950. !
  951. ENDIF
  952. ! ! ========================= !
  953. ! ! wind stress module ! (taum)
  954. ! ! ========================= !
  955. !
  956. IF( ln_force_windstress ) THEN
  957. !CDIR NOVERRCHK
  958. DO jj = 2, jpjm1
  959. !CDIR NOVERRCHK
  960. DO ji = fs_2, fs_jpim1 ! vect. opt.
  961. zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
  962. zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)
  963. frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
  964. END DO
  965. END DO
  966. CALL lbc_lnk( frcv(jpr_taum)%z3(:,:,1), 'T', 1. )
  967. llnewtau = .TRUE.
  968. ELSE
  969. IF( .NOT. srcv(jpr_taum)%laction ) THEN ! compute wind stress module from its components if not received
  970. ! => need to be done only when otx1 was changed
  971. IF( llnewtx ) THEN
  972. !CDIR NOVERRCHK
  973. DO jj = 2, jpjm1
  974. !CDIR NOVERRCHK
  975. DO ji = fs_2, fs_jpim1 ! vect. opt.
  976. zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
  977. zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)
  978. frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
  979. END DO
  980. END DO
  981. CALL lbc_lnk( frcv(jpr_taum)%z3(:,:,1), 'T', 1. )
  982. llnewtau = .TRUE.
  983. ELSE
  984. llnewtau = .FALSE.
  985. ENDIF
  986. ELSE
  987. llnewtau = nrcvinfo(jpr_taum) == OASIS_Rcv
  988. ! Stress module can be negative when received (interpolation problem)
  989. IF( llnewtau ) THEN
  990. frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) )
  991. ENDIF
  992. ENDIF
  993. ENDIF
  994. !
  995. ! ! ========================= !
  996. ! ! 10 m wind speed ! (wndm)
  997. ! ! ========================= !
  998. !
  999. IF( ln_force_windstress ) THEN
  1000. zcoef = 1. / ( zrhoa * zcdrag )
  1001. !CDIR NOVERRCHK
  1002. DO jj = 1, jpj
  1003. !CDIR NOVERRCHK
  1004. DO ji = 1, jpi
  1005. frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
  1006. END DO
  1007. END DO
  1008. ELSE
  1009. IF( .NOT. srcv(jpr_w10m)%laction ) THEN ! compute wind spreed from wind stress module if not received
  1010. ! => need to be done only when taumod was changed
  1011. IF( llnewtau ) THEN
  1012. zcoef = 1. / ( zrhoa * zcdrag )
  1013. !CDIR NOVERRCHK
  1014. DO jj = 1, jpj
  1015. !CDIR NOVERRCHK
  1016. DO ji = 1, jpi
  1017. frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
  1018. END DO
  1019. END DO
  1020. ENDIF
  1021. ENDIF
  1022. ENDIF
  1023. !
  1024. ! u(v)tau and taum will be modified by ice model
  1025. ! -> need to be reset before each call of the ice/fsbc
  1026. IF( MOD( kt-1, k_fsbc ) == 0 ) THEN
  1027. !
  1028. IF( ln_mixcpl ) THEN
  1029. utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:)
  1030. vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:)
  1031. taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:)
  1032. wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:)
  1033. ELSE
  1034. utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)
  1035. vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)
  1036. taum(:,:) = frcv(jpr_taum)%z3(:,:,1)
  1037. wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)
  1038. ENDIF
  1039. CALL iom_put( "taum_oce", taum ) ! output wind stress module
  1040. !
  1041. ENDIF
  1042. #if defined key_cpl_carbon_cycle
  1043. ! ! ================== !
  1044. ! ! atmosph. CO2 (ppm) !
  1045. ! ! ================== !
  1046. IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1)
  1047. #endif
  1048. ! Fields received by SAS when OASIS coupling
  1049. ! (arrays no more filled at sbcssm stage)
  1050. ! ! ================== !
  1051. ! ! SSS !
  1052. ! ! ================== !
  1053. IF( srcv(jpr_soce)%laction ) THEN ! received by sas in case of opa <-> sas coupling
  1054. sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1)
  1055. CALL iom_put( 'sss_m', sss_m )
  1056. ENDIF
  1057. !
  1058. ! ! ================== !
  1059. ! ! SST !
  1060. ! ! ================== !
  1061. IF( srcv(jpr_toce)%laction ) THEN ! received by sas in case of opa <-> sas coupling
  1062. sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1)
  1063. IF( srcv(jpr_soce)%laction .AND. ln_useCT ) THEN ! make sure that sst_m is the potential temperature
  1064. sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) )
  1065. ENDIF
  1066. ENDIF
  1067. ! ! ================== !
  1068. ! ! SSH !
  1069. ! ! ================== !
  1070. IF( srcv(jpr_ssh )%laction ) THEN ! received by sas in case of opa <-> sas coupling
  1071. ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1)
  1072. CALL iom_put( 'ssh_m', ssh_m )
  1073. ENDIF
  1074. ! ! ================== !
  1075. ! ! surface currents !
  1076. ! ! ================== !
  1077. IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling
  1078. ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1)
  1079. ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau
  1080. un (:,:,1) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling
  1081. CALL iom_put( 'ssu_m', ssu_m )
  1082. ENDIF
  1083. IF( srcv(jpr_ocy1)%laction ) THEN
  1084. ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
  1085. vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau
  1086. vn (:,:,1) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling
  1087. CALL iom_put( 'ssv_m', ssv_m )
  1088. ENDIF
  1089. ! ! ======================== !
  1090. ! ! first T level thickness !
  1091. ! ! ======================== !
  1092. IF( srcv(jpr_e3t1st )%laction ) THEN ! received by sas in case of opa <-> sas coupling
  1093. e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1)
  1094. CALL iom_put( 'e3t_m', e3t_m(:,:) )
  1095. ENDIF
  1096. ! ! ================================ !
  1097. ! ! fraction of solar net radiation !
  1098. ! ! ================================ !
  1099. IF( srcv(jpr_fraqsr)%laction ) THEN ! received by sas in case of opa <-> sas coupling
  1100. frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1)
  1101. CALL iom_put( 'frq_m', frq_m )
  1102. ENDIF
  1103. ! ! ========================= !
  1104. IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN ! heat & freshwater fluxes ! (Ocean only case)
  1105. ! ! ========================= !
  1106. !
  1107. ! ! total freshwater fluxes over the ocean (emp)
  1108. IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN
  1109. SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation
  1110. CASE( 'conservative' )
  1111. zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
  1112. CASE( 'oce only', 'oce and ice' )
  1113. zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
  1114. CASE default
  1115. CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
  1116. END SELECT
  1117. ELSE
  1118. zemp(:,:) = 0._wp
  1119. ENDIF
  1120. !
  1121. !
  1122. ! ! runoffs and calving (added in emp)
  1123. IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
  1124. IF( srcv(jpr_cal)%laction ) zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1)
  1125. IF( srcv(jpr_icb)%laction ) THEN
  1126. fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
  1127. rnf(:,:) = rnf(:,:) + fwficb(:,:) ! iceberg added to runfofs
  1128. ENDIF
  1129. IF( srcv(jpr_isf)%laction ) fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting)
  1130. IF( ln_mixcpl ) THEN ; emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
  1131. ELSE ; emp(:,:) = zemp(:,:)
  1132. ENDIF
  1133. !
  1134. ! ! non solar heat flux over the ocean (qns)
  1135. IF( srcv(jpr_qnsoce)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
  1136. ELSE IF( srcv(jpr_qnsmix)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
  1137. ELSE ; zqns(:,:) = 0._wp
  1138. END IF
  1139. ! update qns over the free ocean with:
  1140. IF( nn_components /= jp_iam_opa ) THEN
  1141. zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST)
  1142. IF( srcv(jpr_snow )%laction ) THEN
  1143. zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean
  1144. ENDIF
  1145. ENDIF
  1146. !
  1147. IF( srcv(jpr_icb)%laction ) zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus ! remove heat content associated to iceberg melting
  1148. !
  1149. IF( ln_mixcpl ) THEN ; qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:)
  1150. ELSE ; qns(:,:) = zqns(:,:)
  1151. ENDIF
  1152. ! ! solar flux over the ocean (qsr)
  1153. IF ( srcv(jpr_qsroce)%laction ) THEN ; zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
  1154. ELSE IF( srcv(jpr_qsrmix)%laction ) then ; zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
  1155. ELSE ; zqsr(:,:) = 0._wp
  1156. ENDIF
  1157. IF( ln_dm2dc .AND. ln_cpl ) zqsr(:,:) = sbc_dcy( zqsr ) ! modify qsr to include the diurnal cycle
  1158. IF( ln_mixcpl ) THEN ; qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:)
  1159. ELSE ; qsr(:,:) = zqsr(:,:)
  1160. ENDIF
  1161. !
  1162. ! salt flux over the ocean (received by opa in case of opa <-> sas coupling)
  1163. IF( srcv(jpr_sflx )%laction ) sfx(:,:) = frcv(jpr_sflx )%z3(:,:,1)
  1164. ! Ice cover (received by opa in case of opa <-> sas coupling)
  1165. IF( srcv(jpr_fice )%laction ) fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1)
  1166. !
  1167. ENDIF
  1168. !
  1169. CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )
  1170. !
  1171. IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv')
  1172. !
  1173. END SUBROUTINE sbc_cpl_rcv
  1174. SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )
  1175. !!----------------------------------------------------------------------
  1176. !! *** ROUTINE sbc_cpl_ice_tau ***
  1177. !!
  1178. !! ** Purpose : provide the stress over sea-ice in coupled mode
  1179. !!
  1180. !! ** Method : transform the received stress from the atmosphere into
  1181. !! an atmosphere-ice stress in the (i,j) ocean referencial
  1182. !! and at the velocity point of the sea-ice model (cp_ice_msh):
  1183. !! 'C'-grid : i- (j-) components given at U- (V-) point
  1184. !! 'I'-grid : B-grid lower-left corner: both components given at I-point
  1185. !!
  1186. !! The received stress are :
  1187. !! - defined by 3 components (if cartesian coordinate)
  1188. !! or by 2 components (if spherical)
  1189. !! - oriented along geographical coordinate (if eastward-northward)
  1190. !! or along the local grid coordinate (if local grid)
  1191. !! - given at U- and V-point, resp. if received on 2 grids
  1192. !! or at a same point (T or I) if received on 1 grid
  1193. !! Therefore and if necessary, they are successively
  1194. !! processed in order to obtain them
  1195. !! first as 2 components on the sphere
  1196. !! second as 2 components oriented along the local grid
  1197. !! third as 2 components on the cp_ice_msh point
  1198. !!
  1199. !! Except in 'oce and ice' case, only one vector stress field
  1200. !! is received. It has already been processed in sbc_cpl_rcv
  1201. !! so that it is now defined as (i,j) components given at U-
  1202. !! and V-points, respectively. Therefore, only the third
  1203. !! transformation is done and only if the ice-grid is a 'I'-grid.
  1204. !!
  1205. !! ** Action : return ptau_i, ptau_j, the stress over the ice at cp_ice_msh point
  1206. !!----------------------------------------------------------------------
  1207. REAL(wp), INTENT(out), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2]
  1208. REAL(wp), INTENT(out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid)
  1209. !!
  1210. INTEGER :: ji, jj ! dummy loop indices
  1211. INTEGER :: itx ! index of taux over ice
  1212. REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty
  1213. !!----------------------------------------------------------------------
  1214. !
  1215. IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_tau')
  1216. !
  1217. CALL wrk_alloc( jpi,jpj, ztx, zty )
  1218. IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1
  1219. ELSE ; itx = jpr_otx1
  1220. ENDIF
  1221. ! do something only if we just received the stress from atmosphere
  1222. IF( nrcvinfo(itx) == OASIS_Rcv ) THEN
  1223. ! ! ======================= !
  1224. IF( srcv(jpr_itx1)%laction ) THEN ! ice stress received !
  1225. ! ! ======================= !
  1226. !
  1227. IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere
  1228. ! ! (cartesian to spherical -> 3 to 2 components)
  1229. CALL geo2oce( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1), &
  1230. & srcv(jpr_itx1)%clgrid, ztx, zty )
  1231. frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid
  1232. frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid
  1233. !
  1234. IF( srcv(jpr_itx2)%laction ) THEN
  1235. CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1), &
  1236. & srcv(jpr_itx2)%clgrid, ztx, zty )
  1237. frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid
  1238. frcv(jpr_ity2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid
  1239. ENDIF
  1240. !
  1241. ENDIF
  1242. !
  1243. IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid
  1244. ! ! (geographical to local grid -> rotate the components)
  1245. CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )
  1246. IF( srcv(jpr_itx2)%laction ) THEN
  1247. CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )
  1248. ELSE
  1249. CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty )
  1250. ENDIF
  1251. frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid
  1252. frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid
  1253. ENDIF
  1254. !
  1255. IF( ln_force_windstress ) THEN
  1256. frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_itx1)%z3(:,:,1) + 1d0*sf_tau_anom(1)%fnow(:,:,1)
  1257. frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_ity1)%z3(:,:,1) + 1d0*sf_tau_anom(2)%fnow(:,:,1)
  1258. ENDIF
  1259. !
  1260. ! ! ======================= !
  1261. ELSE ! use ocean stress !
  1262. ! ! ======================= !
  1263. frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1)
  1264. frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1)
  1265. !
  1266. ENDIF
  1267. ! ! ======================= !
  1268. ! ! put on ice grid !
  1269. ! ! ======================= !
  1270. !
  1271. ! j+1 j -----V---F
  1272. ! ice stress on ice velocity point (cp_ice_msh) ! |
  1273. ! (C-grid ==>(U,V) or B-grid ==> I or F) j | T U
  1274. ! | |
  1275. ! j j-1 -I-------|
  1276. ! (for I) | |
  1277. ! i-1 i i
  1278. ! i i+1 (for I)
  1279. SELECT CASE ( cp_ice_msh )
  1280. !
  1281. CASE( 'I' ) ! B-grid ==> I
  1282. SELECT CASE ( srcv(jpr_itx1)%clgrid )
  1283. CASE( 'U' )
  1284. DO jj = 2, jpjm1 ! (U,V) ==> I
  1285. DO ji = 2, jpim1 ! NO vector opt.
  1286. p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji-1,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )
  1287. p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )
  1288. END DO
  1289. END DO
  1290. CASE( 'F' )
  1291. DO jj = 2, jpjm1 ! F ==> I
  1292. DO ji = 2, jpim1 ! NO vector opt.
  1293. p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji-1,jj-1,1)
  1294. p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji-1,jj-1,1)
  1295. END DO
  1296. END DO
  1297. CASE( 'T' )
  1298. DO jj = 2, jpjm1 ! T ==> I
  1299. DO ji = 2, jpim1 ! NO vector opt.
  1300. p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj ,1) &
  1301. & + frcv(jpr_itx1)%z3(ji,jj-1,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )
  1302. p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) &
  1303. & + frcv(jpr_oty1)%z3(ji,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )
  1304. END DO
  1305. END DO
  1306. CASE( 'I' )
  1307. p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! I ==> I
  1308. p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
  1309. END SELECT
  1310. IF( srcv(jpr_itx1)%clgrid /= 'I' ) THEN
  1311. CALL lbc_lnk( p_taui, 'I', -1. ) ; CALL lbc_lnk( p_tauj, 'I', -1. )
  1312. ENDIF
  1313. !
  1314. CASE( 'F' ) ! B-grid ==> F
  1315. SELECT CASE ( srcv(jpr_itx1)%clgrid )
  1316. CASE( 'U' )
  1317. DO jj = 2, jpjm1 ! (U,V) ==> F
  1318. DO ji = fs_2, fs_jpim1 ! vector opt.
  1319. p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj+1,1) )
  1320. p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) )
  1321. END DO
  1322. END DO
  1323. CASE( 'I' )
  1324. DO jj = 2, jpjm1 ! I ==> F
  1325. DO ji = 2, jpim1 ! NO vector opt.
  1326. p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji+1,jj+1,1)
  1327. p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji+1,jj+1,1)
  1328. END DO
  1329. END DO
  1330. CASE( 'T' )
  1331. DO jj = 2, jpjm1 ! T ==> F
  1332. DO ji = 2, jpim1 ! NO vector opt.
  1333. p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) &
  1334. & + frcv(jpr_itx1)%z3(ji,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj+1,1) )
  1335. p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) &
  1336. & + frcv(jpr_ity1)%z3(ji,jj+1,1) + frcv(jpr_ity1)%z3(ji+1,jj+1,1) )
  1337. END DO
  1338. END DO
  1339. CASE( 'F' )
  1340. p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! F ==> F
  1341. p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
  1342. END SELECT
  1343. IF( srcv(jpr_itx1)%clgrid /= 'F' ) THEN
  1344. CALL lbc_lnk( p_taui, 'F', -1. ) ; CALL lbc_lnk( p_tauj, 'F', -1. )
  1345. ENDIF
  1346. !
  1347. CASE( 'C' ) ! C-grid ==> U,V
  1348. SELECT CASE ( srcv(jpr_itx1)%clgrid )
  1349. CASE( 'U' )
  1350. p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! (U,V) ==> (U,V)
  1351. p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
  1352. CASE( 'F' )
  1353. DO jj = 2, jpjm1 ! F ==> (U,V)
  1354. DO ji = fs_2, fs_jpim1 ! vector opt.
  1355. p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj-1,1) )
  1356. p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(jj,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) )
  1357. END DO
  1358. END DO
  1359. CASE( 'T' )
  1360. DO jj = 2, jpjm1 ! T ==> (U,V)
  1361. DO ji = fs_2, fs_jpim1 ! vector opt.
  1362. p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
  1363. p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
  1364. END DO
  1365. END DO
  1366. CASE( 'I' )
  1367. DO jj = 2, jpjm1 ! I ==> (U,V)
  1368. DO ji = 2, jpim1 ! NO vector opt.
  1369. p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) )
  1370. p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji ,jj+1,1) )
  1371. END DO
  1372. END DO
  1373. END SELECT
  1374. IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN
  1375. CALL lbc_lnk( p_taui, 'U', -1. ) ; CALL lbc_lnk( p_tauj, 'V', -1. )
  1376. ENDIF
  1377. END SELECT
  1378. ENDIF
  1379. !
  1380. CALL wrk_dealloc( jpi,jpj, ztx, zty )
  1381. !
  1382. IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_tau')
  1383. !
  1384. END SUBROUTINE sbc_cpl_ice_tau
  1385. SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist )
  1386. !!----------------------------------------------------------------------
  1387. !! *** ROUTINE sbc_cpl_ice_flx ***
  1388. !!
  1389. !! ** Purpose : provide the heat and freshwater fluxes of the ocean-ice system
  1390. !!
  1391. !! ** Method : transform the fields received from the atmosphere into
  1392. !! surface heat and fresh water boundary condition for the
  1393. !! ice-ocean system. The following fields are provided:
  1394. !! * total non solar, solar and freshwater fluxes (qns_tot,
  1395. !! qsr_tot and emp_tot) (total means weighted ice-ocean flux)
  1396. !! NB: emp_tot include runoffs and calving.
  1397. !! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where
  1398. !! emp_ice = sublimation - solid precipitation as liquid
  1399. !! precipitation are re-routed directly to the ocean and
  1400. !! calving directly enter the ocean (runoffs are read but included in trasbc.F90)
  1401. !! * solid precipitation (sprecip), used to add to qns_tot
  1402. !! the heat lost associated to melting solid precipitation
  1403. !! over the ocean fraction.
  1404. !! * heat content of rain, snow and evap can also be provided,
  1405. !! otherwise heat flux associated with these mass flux are
  1406. !! guessed (qemp_oce, qemp_ice)
  1407. !!
  1408. !! - the fluxes have been separated from the stress as
  1409. !! (a) they are updated at each ice time step compare to
  1410. !! an update at each coupled time step for the stress, and
  1411. !! (b) the conservative computation of the fluxes over the
  1412. !! sea-ice area requires the knowledge of the ice fraction
  1413. !! after the ice advection and before the ice thermodynamics,
  1414. !! so that the stress is updated before the ice dynamics
  1415. !! while the fluxes are updated after it.
  1416. !!
  1417. !! ** Details
  1418. !! qns_tot = pfrld * qns_oce + ( 1 - pfrld ) * qns_ice => provided
  1419. !! + qemp_oce + qemp_ice => recalculated and added up to qns
  1420. !!
  1421. !! qsr_tot = pfrld * qsr_oce + ( 1 - pfrld ) * qsr_ice => provided
  1422. !!
  1423. !! emp_tot = emp_oce + emp_ice => calving is provided and added to emp_tot (and emp_oce).
  1424. !! runoff (which includes rivers+icebergs) and iceshelf
  1425. !! are provided but not included in emp here. Only runoff will
  1426. !! be included in emp in other parts of NEMO code
  1427. !! ** Action : update at each nf_ice time step:
  1428. !! qns_tot, qsr_tot non-solar and solar total heat fluxes
  1429. !! qns_ice, qsr_ice non-solar and solar heat fluxes over the ice
  1430. !! emp_tot total evaporation - precipitation(liquid and solid) (-calving)
  1431. !! emp_ice ice sublimation - solid precipitation over the ice
  1432. !! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice
  1433. !! sprecip solid precipitation over the ocean
  1434. !!----------------------------------------------------------------------
  1435. REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1]
  1436. ! optional arguments, used only in 'mixed oce-ice' case
  1437. REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo
  1438. REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius]
  1439. REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin]
  1440. !
  1441. INTEGER :: jl ! dummy loop index
  1442. REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw
  1443. REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice
  1444. REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice
  1445. REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice
  1446. !!----------------------------------------------------------------------
  1447. !
  1448. IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx')
  1449. !
  1450. CALL wrk_alloc( jpi,jpj, zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw )
  1451. CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice )
  1452. CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )
  1453. CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )
  1454. IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0)
  1455. zicefr(:,:) = 1.- p_frld(:,:)
  1456. zcptn(:,:) = rcp * sst_m(:,:)
  1457. !
  1458. ! ! ========================= !
  1459. ! ! freshwater budget ! (emp_tot)
  1460. ! ! ========================= !
  1461. !
  1462. ! ! solid Precipitation (sprecip)
  1463. ! ! liquid + solid Precipitation (tprecip)
  1464. ! ! total Evaporation - total Precipitation (emp_tot)
  1465. ! ! sublimation - solid precipitation (cell average) (emp_ice)
  1466. SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
  1467. CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
  1468. zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here
  1469. ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here
  1470. zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)
  1471. zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:)
  1472. CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
  1473. zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
  1474. zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:)
  1475. zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1)
  1476. ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:)
  1477. END SELECT
  1478. #if defined key_lim3
  1479. ! zsnw = snow fraction over ice after wind blowing (=zicefr if no blowing)
  1480. zsnw(:,:) = 0._wp ; CALL lim_thd_snwblow( p_frld, zsnw )
  1481. ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- !
  1482. zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip
  1483. zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) ! emp_oce = emp_tot - emp_ice
  1484. ! --- evaporation over ocean (used later for qemp) --- !
  1485. zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)
  1486. ! --- evaporation over ice (kg/m2/s) --- !
  1487. zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1)
  1488. ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0
  1489. ! therefore, sublimation is not redistributed over the ice categories when no subgrid scale fluxes are provided by atm.
  1490. zdevap_ice(:,:) = 0._wp
  1491. ! --- Continental fluxes --- !
  1492. IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on)
  1493. rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
  1494. ENDIF
  1495. IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot and emp_oce)
  1496. zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
  1497. zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1)
  1498. ENDIF
  1499. IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs
  1500. fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
  1501. rnf(:,:) = rnf(:,:) + fwficb(:,:)
  1502. ENDIF
  1503. IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting)
  1504. fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)
  1505. ENDIF
  1506. IF( ln_mixcpl ) THEN
  1507. emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
  1508. emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
  1509. emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:)
  1510. sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
  1511. tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
  1512. DO jl=1,jpl
  1513. evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:) * zmsk(:,:)
  1514. devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:)
  1515. ENDDO
  1516. ELSE
  1517. emp_tot(:,:) = zemp_tot(:,:)
  1518. emp_ice(:,:) = zemp_ice(:,:)
  1519. emp_oce(:,:) = zemp_oce(:,:)
  1520. sprecip(:,:) = zsprecip(:,:)
  1521. tprecip(:,:) = ztprecip(:,:)
  1522. DO jl=1,jpl
  1523. evap_ice (:,:,jl) = zevap_ice (:,:)
  1524. devap_ice(:,:,jl) = zdevap_ice(:,:)
  1525. ENDDO
  1526. ENDIF
  1527. #else
  1528. zsnw(:,:) = zicefr(:,:)
  1529. ! --- Continental fluxes --- !
  1530. IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on)
  1531. rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
  1532. ENDIF
  1533. IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot)
  1534. zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
  1535. ENDIF
  1536. IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs
  1537. fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
  1538. rnf(:,:) = rnf(:,:) + fwficb(:,:)
  1539. ENDIF
  1540. IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting)
  1541. fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)
  1542. ENDIF
  1543. IF( ln_mixcpl ) THEN
  1544. emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
  1545. emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
  1546. sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
  1547. tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
  1548. ELSE
  1549. emp_tot(:,:) = zemp_tot(:,:)
  1550. emp_ice(:,:) = zemp_ice(:,:)
  1551. sprecip(:,:) = zsprecip(:,:)
  1552. tprecip(:,:) = ztprecip(:,:)
  1553. ENDIF
  1554. #endif
  1555. ! outputs
  1556. !! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff
  1557. !! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf
  1558. IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving
  1559. IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs
  1560. IF( iom_use('snowpre') ) CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow
  1561. IF( iom_use('precip') ) CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation
  1562. IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation
  1563. IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average)
  1564. IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average)
  1565. IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * p_frld(:,:) ) ! liquid precipitation over ocean (cell average)
  1566. IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average)
  1567. IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) &
  1568. & - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)
  1569. ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf
  1570. !
  1571. ! ! ========================= !
  1572. SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns)
  1573. ! ! ========================= !
  1574. CASE( 'oce only' ) ! the required field is directly provided
  1575. zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
  1576. CASE( 'conservative' ) ! the required fields are directly provided
  1577. zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
  1578. IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
  1579. zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
  1580. ELSE
  1581. DO jl=1,jpl
  1582. zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal
  1583. ENDDO
  1584. ENDIF
  1585. CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes
  1586. zqns_tot(:,:) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
  1587. IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
  1588. DO jl=1,jpl
  1589. zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)
  1590. zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
  1591. ENDDO
  1592. ELSE
  1593. qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
  1594. DO jl=1,jpl
  1595. zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
  1596. zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
  1597. ENDDO
  1598. ENDIF
  1599. CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations
  1600. ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
  1601. zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)
  1602. zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) &
  1603. & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) &
  1604. & + pist(:,:,1) * zicefr(:,:) ) )
  1605. END SELECT
  1606. IF( iom_use('qns_mix') ) CALL iom_put( 'qns_mix', zqns_tot(:,:) ) ! total qns_mix flux received
  1607. !
  1608. ! --- calving (removed from qns_tot) --- !
  1609. IF( srcv(jpr_cal)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * lfus ! remove latent heat of calving
  1610. ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean
  1611. ! --- iceberg (removed from qns_tot) --- !
  1612. IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus ! remove latent heat of iceberg melting
  1613. #if defined key_lim3
  1614. ! --- non solar flux over ocean --- !
  1615. ! note: p_frld cannot be = 0 since we limit the ice concentration to amax
  1616. zqns_oce = 0._wp
  1617. WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:)
  1618. ! Heat content per unit mass of snow (J/kg)
  1619. WHERE( SUM( a_i, dim=3 ) > 1.e-10 ) ; zcptsnw(:,:) = cpic * SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 )
  1620. ELSEWHERE ; zcptsnw(:,:) = zcptn(:,:)
  1621. ENDWHERE
  1622. ! Heat content per unit mass of rain (J/kg)
  1623. zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * p_frld(:,:) )
  1624. ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- !
  1625. zqprec_ice(:,:) = rhosn * ( zcptsnw(:,:) - lfus )
  1626. ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- !
  1627. DO jl = 1, jpl
  1628. zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but atm. does not take it into account
  1629. END DO
  1630. ! --- heat flux associated with emp (W/m2) --- !
  1631. zqemp_oce(:,:) = - zevap_oce(:,:) * zcptn (:,:) & ! evap
  1632. & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptrain(:,:) & ! liquid precip
  1633. & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - lfus ) ! solid precip over ocean + snow melting
  1634. zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptsnw (:,:) - lfus ) ! solid precip over ice (qevap_ice=0 since atm. does not take it into account)
  1635. !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptsnw (:,:) & ! ice evap
  1636. !! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhosn ! solid precip over ice
  1637. ! --- total non solar flux (including evap/precip) --- !
  1638. zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:)
  1639. ! --- in case both coupled/forced are active, we must mix values --- !
  1640. IF( ln_mixcpl ) THEN
  1641. qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
  1642. qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:)
  1643. DO jl=1,jpl
  1644. qns_ice (:,:,jl) = qns_ice (:,:,jl) * xcplmask(:,:,0) + zqns_ice (:,:,jl)* zmsk(:,:)
  1645. qevap_ice(:,:,jl) = qevap_ice(:,:,jl) * xcplmask(:,:,0) + zqevap_ice(:,:,jl)* zmsk(:,:)
  1646. ENDDO
  1647. qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:)
  1648. qemp_oce (:,:) = qemp_oce(:,:) * xcplmask(:,:,0) + zqemp_oce(:,:)* zmsk(:,:)
  1649. qemp_ice (:,:) = qemp_ice(:,:) * xcplmask(:,:,0) + zqemp_ice(:,:)* zmsk(:,:)
  1650. ELSE
  1651. qns_tot (:,: ) = zqns_tot (:,: )
  1652. qns_oce (:,: ) = zqns_oce (:,: )
  1653. qns_ice (:,:,:) = zqns_ice (:,:,:)
  1654. qevap_ice(:,:,:) = zqevap_ice(:,:,:)
  1655. qprec_ice(:,: ) = zqprec_ice(:,: )
  1656. qemp_oce (:,: ) = zqemp_oce (:,: )
  1657. qemp_ice (:,: ) = zqemp_ice (:,: )
  1658. ENDIF
  1659. #else
  1660. zcptsnw (:,:) = zcptn(:,:)
  1661. zcptrain(:,:) = zcptn(:,:)
  1662. ! clem: this formulation is certainly wrong... but better than it was...
  1663. zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with:
  1664. & - ( p_frld(:,:) * zsprecip(:,:) * lfus ) & ! remove the latent heat flux of solid precip. melting
  1665. & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST)
  1666. & - zemp_ice(:,:) ) * zcptn(:,:)
  1667. IF( ln_mixcpl ) THEN
  1668. qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk
  1669. qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
  1670. DO jl=1,jpl
  1671. qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:)
  1672. ENDDO
  1673. ELSE
  1674. qns_tot(:,: ) = zqns_tot(:,: )
  1675. qns_ice(:,:,:) = zqns_ice(:,:,:)
  1676. ENDIF
  1677. #endif
  1678. ! outputs
  1679. IF( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * lfus ) ! latent heat from calving
  1680. IF( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * lfus ) ! latent heat from icebergs melting
  1681. IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea', sprecip(:,:) * ( zcptsnw(:,:) - Lfus ) ) ! heat flux from snow (cell average)
  1682. IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea',( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average)
  1683. IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea',(frcv(jpr_tevp)%z3(:,:,1)-frcv(jpr_ievp)%z3(:,:,1)*zicefr(:,:)) & ! heat flux from from evap (cell average)
  1684. & * zcptn(:,:) * tmask(:,:,1) )
  1685. IF( iom_use('hflx_prec_cea') ) CALL iom_put('hflx_prec_cea', sprecip(:,:) * ( zcptsnw(:,:) - Lfus ) + & ! heat flux from all precip (cell avg)
  1686. & ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )
  1687. IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea',sprecip(:,:) * (zcptsnw(:,:) - Lfus) * (1._wp - zsnw(:,:))) ! heat flux from snow (over ocean)
  1688. IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea',sprecip(:,:) * (zcptsnw(:,:) - Lfus) * zsnw(:,:) ) ! heat flux from snow (over ice)
  1689. ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp.
  1690. !
  1691. ! ! ========================= !
  1692. SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr)
  1693. ! ! ========================= !
  1694. CASE( 'oce only' )
  1695. zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
  1696. CASE( 'conservative' )
  1697. zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
  1698. IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
  1699. zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
  1700. ELSE
  1701. ! Set all category values equal for the moment
  1702. DO jl=1,jpl
  1703. zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
  1704. ENDDO
  1705. ENDIF
  1706. zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
  1707. zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
  1708. CASE( 'oce and ice' )
  1709. zqsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
  1710. IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
  1711. DO jl=1,jpl
  1712. zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)
  1713. zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
  1714. ENDDO
  1715. ELSE
  1716. qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
  1717. DO jl=1,jpl
  1718. zqsr_tot(:,: ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
  1719. zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
  1720. ENDDO
  1721. ENDIF
  1722. CASE( 'mixed oce-ice' )
  1723. zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
  1724. ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
  1725. ! Create solar heat flux over ice using incoming solar heat flux and albedos
  1726. ! ( see OASIS3 user guide, 5th edition, p39 )
  1727. zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) &
  1728. & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) &
  1729. & + palbi (:,:,1) * zicefr(:,:) ) )
  1730. END SELECT
  1731. IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle
  1732. zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) )
  1733. DO jl=1,jpl
  1734. zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) )
  1735. ENDDO
  1736. ENDIF
  1737. #if defined key_lim3
  1738. ! --- solar flux over ocean --- !
  1739. ! note: p_frld cannot be = 0 since we limit the ice concentration to amax
  1740. zqsr_oce = 0._wp
  1741. WHERE( p_frld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:)
  1742. IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:)
  1743. ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF
  1744. #endif
  1745. IF( ln_mixcpl ) THEN
  1746. qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk
  1747. qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:)
  1748. DO jl=1,jpl
  1749. qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:)
  1750. ENDDO
  1751. ELSE
  1752. qsr_tot(:,: ) = zqsr_tot(:,: )
  1753. qsr_ice(:,:,:) = zqsr_ice(:,:,:)
  1754. ENDIF
  1755. ! ! ========================= !
  1756. SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt !
  1757. ! ! ========================= !
  1758. CASE ('coupled')
  1759. IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
  1760. zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
  1761. ELSE
  1762. ! Set all category values equal for the moment
  1763. DO jl=1,jpl
  1764. zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
  1765. ENDDO
  1766. ENDIF
  1767. END SELECT
  1768. IF( ln_mixcpl ) THEN
  1769. DO jl=1,jpl
  1770. dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)
  1771. ENDDO
  1772. ELSE
  1773. dqns_ice(:,:,:) = zdqns_ice(:,:,:)
  1774. ENDIF
  1775. ! ! ========================= !
  1776. SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt !
  1777. ! ! ========================= !
  1778. CASE ('coupled')
  1779. topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:)
  1780. botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:)
  1781. END SELECT
  1782. ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 )
  1783. ! Used for LIM2 and LIM3
  1784. ! Coupled case: since cloud cover is not received from atmosphere
  1785. ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81)
  1786. fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
  1787. fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
  1788. CALL wrk_dealloc( jpi,jpj, zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw )
  1789. CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice )
  1790. CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )
  1791. CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )
  1792. !
  1793. IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx')
  1794. !
  1795. END SUBROUTINE sbc_cpl_ice_flx
  1796. SUBROUTINE sbc_cpl_snd( kt )
  1797. !!----------------------------------------------------------------------
  1798. !! *** ROUTINE sbc_cpl_snd ***
  1799. !!
  1800. !! ** Purpose : provide the ocean-ice informations to the atmosphere
  1801. !!
  1802. !! ** Method : send to the atmosphere through a call to cpl_snd
  1803. !! all the needed fields (as defined in sbc_cpl_init)
  1804. !!----------------------------------------------------------------------
  1805. INTEGER, INTENT(in) :: kt
  1806. !
  1807. INTEGER :: ji, jj, jl ! dummy loop indices
  1808. INTEGER :: isec, info ! local integer
  1809. REAL(wp) :: zumax, zvmax
  1810. REAL(wp), POINTER, DIMENSION(:,:) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
  1811. REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp3, ztmp4
  1812. !!----------------------------------------------------------------------
  1813. !
  1814. IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_snd')
  1815. !
  1816. CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
  1817. CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 )
  1818. isec = ( kt - nit000 ) * NINT(rdttra(1)) ! date of exchanges
  1819. zfr_l(:,:) = 1.- fr_i(:,:)
  1820. ! ! ------------------------- !
  1821. ! ! Surface temperature ! in Kelvin
  1822. ! ! ------------------------- !
  1823. IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
  1824. IF ( nn_components == jp_iam_opa ) THEN
  1825. ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part
  1826. ELSE
  1827. ! we must send the surface potential temperature
  1828. IF( ln_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
  1829. ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem)
  1830. ENDIF
  1831. !
  1832. SELECT CASE( sn_snd_temp%cldes)
  1833. CASE( 'oce only' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0
  1834. CASE( 'oce and ice' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0
  1835. SELECT CASE( sn_snd_temp%clcat )
  1836. CASE( 'yes' )
  1837. ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl)
  1838. CASE( 'no' )
  1839. WHERE( SUM( a_i, dim=3 ) /= 0. )
  1840. ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 )
  1841. ELSEWHERE
  1842. ztmp3(:,:,1) = rt0
  1843. END WHERE
  1844. CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
  1845. END SELECT
  1846. CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)
  1847. SELECT CASE( sn_snd_temp%clcat )
  1848. CASE( 'yes' )
  1849. ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
  1850. CASE( 'no' )
  1851. ztmp3(:,:,:) = 0.0
  1852. DO jl=1,jpl
  1853. ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
  1854. ENDDO
  1855. CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
  1856. END SELECT
  1857. CASE( 'mixed oce-ice' )
  1858. ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)
  1859. DO jl=1,jpl
  1860. ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
  1861. ENDDO
  1862. CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
  1863. END SELECT
  1864. ENDIF
  1865. IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
  1866. IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info )
  1867. IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
  1868. ENDIF
  1869. ! ! ------------------------- !
  1870. ! ! Albedo !
  1871. ! ! ------------------------- !
  1872. IF( ssnd(jps_albice)%laction ) THEN ! ice
  1873. SELECT CASE( sn_snd_alb%cldes )
  1874. CASE( 'ice' )
  1875. SELECT CASE( sn_snd_alb%clcat )
  1876. CASE( 'yes' )
  1877. ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
  1878. CASE( 'no' )
  1879. WHERE( SUM( a_i, dim=3 ) /= 0. )
  1880. ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 )
  1881. ELSEWHERE
  1882. ztmp1(:,:) = albedo_oce_mix(:,:)
  1883. END WHERE
  1884. CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' )
  1885. END SELECT
  1886. CASE( 'weighted ice' ) ;
  1887. SELECT CASE( sn_snd_alb%clcat )
  1888. CASE( 'yes' )
  1889. ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
  1890. CASE( 'no' )
  1891. WHERE( fr_i (:,:) > 0. )
  1892. ztmp1(:,:) = SUM ( alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 )
  1893. ELSEWHERE
  1894. ztmp1(:,:) = 0.
  1895. END WHERE
  1896. CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' )
  1897. END SELECT
  1898. CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' )
  1899. END SELECT
  1900. SELECT CASE( sn_snd_alb%clcat )
  1901. CASE( 'yes' )
  1902. CALL cpl_snd( jps_albice, isec, ztmp3, info ) !-> MV this has never been checked in coupled mode
  1903. CASE( 'no' )
  1904. CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
  1905. END SELECT
  1906. ENDIF
  1907. IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean
  1908. ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:)
  1909. DO jl=1,jpl
  1910. ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl)
  1911. ENDDO
  1912. CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
  1913. ENDIF
  1914. ! ! ------------------------- !
  1915. ! ! Ice fraction & Thickness !
  1916. ! ! ------------------------- !
  1917. ! Send ice fraction field to atmosphere
  1918. IF( ssnd(jps_fice)%laction ) THEN
  1919. SELECT CASE( sn_snd_thick%clcat )
  1920. CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl)
  1921. CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(:,: )
  1922. CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
  1923. END SELECT
  1924. IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info )
  1925. ENDIF
  1926. ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling)
  1927. IF( ssnd(jps_fice2)%laction ) THEN
  1928. ztmp3(:,:,1) = fr_i(:,:)
  1929. IF( ssnd(jps_fice2)%laction ) CALL cpl_snd( jps_fice2, isec, ztmp3, info )
  1930. ENDIF
  1931. ! Send ice and snow thickness field
  1932. IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN
  1933. SELECT CASE( sn_snd_thick%cldes)
  1934. CASE( 'none' ) ! nothing to do
  1935. CASE( 'weighted ice and snow' )
  1936. SELECT CASE( sn_snd_thick%clcat )
  1937. CASE( 'yes' )
  1938. ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) * a_i(:,:,1:jpl)
  1939. ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) * a_i(:,:,1:jpl)
  1940. CASE( 'no' )
  1941. ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0
  1942. DO jl=1,jpl
  1943. ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl)
  1944. ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl)
  1945. ENDDO
  1946. CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
  1947. END SELECT
  1948. CASE( 'ice and snow' )
  1949. SELECT CASE( sn_snd_thick%clcat )
  1950. CASE( 'yes' )
  1951. ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl)
  1952. ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl)
  1953. CASE( 'no' )
  1954. WHERE( SUM( a_i, dim=3 ) /= 0. )
  1955. ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 )
  1956. ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 )
  1957. ELSEWHERE
  1958. ztmp3(:,:,1) = 0.
  1959. ztmp4(:,:,1) = 0.
  1960. END WHERE
  1961. CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
  1962. END SELECT
  1963. CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' )
  1964. END SELECT
  1965. IF( ssnd(jps_hice)%laction ) CALL cpl_snd( jps_hice, isec, ztmp3, info )
  1966. IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info )
  1967. ENDIF
  1968. !
  1969. #if defined key_cpl_carbon_cycle
  1970. ! ! ------------------------- !
  1971. ! ! CO2 flux from PISCES !
  1972. ! ! ------------------------- !
  1973. IF( ssnd(jps_co2)%laction ) CALL cpl_snd( jps_co2, isec, - RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )
  1974. !
  1975. #endif
  1976. ! ! ------------------------- !
  1977. IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current !
  1978. ! ! ------------------------- !
  1979. !
  1980. ! j+1 j -----V---F
  1981. ! surface velocity always sent from T point ! |
  1982. ! j | T U
  1983. ! | |
  1984. ! j j-1 -I-------|
  1985. ! (for I) | |
  1986. ! i-1 i i
  1987. ! i i+1 (for I)
  1988. IF( nn_components == jp_iam_opa ) THEN
  1989. zotx1(:,:) = un(:,:,1)
  1990. zoty1(:,:) = vn(:,:,1)
  1991. ELSE
  1992. SELECT CASE( TRIM( sn_snd_crt%cldes ) )
  1993. CASE( 'oce only' ) ! C-grid ==> T
  1994. DO jj = 2, jpjm1
  1995. DO ji = fs_2, fs_jpim1 ! vector opt.
  1996. zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) )
  1997. zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) )
  1998. END DO
  1999. END DO
  2000. CASE( 'weighted oce and ice' )
  2001. SELECT CASE ( cp_ice_msh )
  2002. CASE( 'C' ) ! Ocean and Ice on C-grid ==> T
  2003. DO jj = 2, jpjm1
  2004. DO ji = fs_2, fs_jpim1 ! vector opt.
  2005. zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj)
  2006. zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj)
  2007. zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
  2008. zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
  2009. END DO
  2010. END DO
  2011. CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T
  2012. DO jj = 2, jpjm1
  2013. DO ji = 2, jpim1 ! NO vector opt.
  2014. zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj)
  2015. zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj)
  2016. zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) &
  2017. & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
  2018. zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) &
  2019. & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
  2020. END DO
  2021. END DO
  2022. CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T
  2023. DO jj = 2, jpjm1
  2024. DO ji = 2, jpim1 ! NO vector opt.
  2025. zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj)
  2026. zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj)
  2027. zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) &
  2028. & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
  2029. zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) &
  2030. & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
  2031. END DO
  2032. END DO
  2033. END SELECT
  2034. CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. )
  2035. CASE( 'mixed oce-ice' )
  2036. SELECT CASE ( cp_ice_msh )
  2037. CASE( 'C' ) ! Ocean and Ice on C-grid ==> T
  2038. DO jj = 2, jpjm1
  2039. DO ji = fs_2, fs_jpim1 ! vector opt.
  2040. zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) &
  2041. & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
  2042. zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) &
  2043. & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
  2044. END DO
  2045. END DO
  2046. CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T
  2047. DO jj = 2, jpjm1
  2048. DO ji = 2, jpim1 ! NO vector opt.
  2049. zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) &
  2050. & + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) &
  2051. & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
  2052. zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) &
  2053. & + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) &
  2054. & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
  2055. END DO
  2056. END DO
  2057. CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T
  2058. DO jj = 2, jpjm1
  2059. DO ji = 2, jpim1 ! NO vector opt.
  2060. zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) &
  2061. & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) &
  2062. & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
  2063. zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) &
  2064. & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) &
  2065. & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
  2066. END DO
  2067. END DO
  2068. END SELECT
  2069. END SELECT
  2070. CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. )
  2071. !
  2072. ENDIF
  2073. !
  2074. !
  2075. IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components
  2076. ! ! Ocean component
  2077. CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component
  2078. CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
  2079. zotx1(:,:) = ztmp1(:,:) ! overwrite the components
  2080. zoty1(:,:) = ztmp2(:,:)
  2081. IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component
  2082. CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component
  2083. CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
  2084. zitx1(:,:) = ztmp1(:,:) ! overwrite the components
  2085. zity1(:,:) = ztmp2(:,:)
  2086. ENDIF
  2087. ENDIF
  2088. !
  2089. ! spherical coordinates to cartesian -> 2 components to 3 components
  2090. IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN
  2091. ztmp1(:,:) = zotx1(:,:) ! ocean currents
  2092. ztmp2(:,:) = zoty1(:,:)
  2093. CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
  2094. !
  2095. IF( ssnd(jps_ivx1)%laction ) THEN ! ice velocities
  2096. ztmp1(:,:) = zitx1(:,:)
  2097. ztmp1(:,:) = zity1(:,:)
  2098. CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
  2099. ENDIF
  2100. ENDIF
  2101. !
  2102. IF( ssnd(jps_ocx1)%laction ) CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid
  2103. IF( ssnd(jps_ocy1)%laction ) CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid
  2104. IF( ssnd(jps_ocz1)%laction ) CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid
  2105. !
  2106. IF( ssnd(jps_ivx1)%laction ) CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid
  2107. IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid
  2108. IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid
  2109. !
  2110. ENDIF
  2111. !
  2112. !
  2113. ! Fields sent by OPA to SAS when doing OPA<->SAS coupling
  2114. ! ! SSH
  2115. IF( ssnd(jps_ssh )%laction ) THEN
  2116. ! ! removed inverse barometer ssh when Patm
  2117. ! forcing is used (for sea-ice dynamics)
  2118. IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
  2119. ELSE ; ztmp1(:,:) = sshn(:,:)
  2120. ENDIF
  2121. CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info )
  2122. ENDIF
  2123. ! ! SSS
  2124. IF( ssnd(jps_soce )%laction ) THEN
  2125. CALL cpl_snd( jps_soce , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info )
  2126. ENDIF
  2127. ! ! first T level thickness
  2128. IF( ssnd(jps_e3t1st )%laction ) THEN
  2129. CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1) , (/jpi,jpj,1/) ), info )
  2130. ENDIF
  2131. ! ! Qsr fraction
  2132. IF( ssnd(jps_fraqsr)%laction ) THEN
  2133. CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info )
  2134. ENDIF
  2135. !
  2136. ! Fields sent by SAS to OPA when OASIS coupling
  2137. ! ! Solar heat flux
  2138. IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info )
  2139. IF( ssnd(jps_qnsoce)%laction ) CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info )
  2140. IF( ssnd(jps_oemp )%laction ) CALL cpl_snd( jps_oemp , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info )
  2141. IF( ssnd(jps_sflx )%laction ) CALL cpl_snd( jps_sflx , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info )
  2142. IF( ssnd(jps_otx1 )%laction ) CALL cpl_snd( jps_otx1 , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info )
  2143. IF( ssnd(jps_oty1 )%laction ) CALL cpl_snd( jps_oty1 , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info )
  2144. IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info )
  2145. IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info )
  2146. CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
  2147. CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )
  2148. !
  2149. IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_snd')
  2150. !
  2151. END SUBROUTINE sbc_cpl_snd
  2152. !!======================================================================
  2153. END MODULE sbccpl