sbccpl.F90 130 KB

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