- Timestamp:
- 2016-11-28T17:04:10+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r7350 r7351 26 26 USE phycst ! physical constants 27 27 #if defined key_lim3 28 USE ice 28 USE ice ! ice variables 29 29 #endif 30 30 #if defined key_lim2 31 USE par_ice_2 32 USE ice_2 31 USE par_ice_2 ! ice parameters 32 USE ice_2 ! ice variables 33 33 #endif 34 USE cpl_oasis3 35 USE geo2ocean 34 USE cpl_oasis3 ! OASIS3 coupling 35 USE geo2ocean ! 36 36 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 37 USE albedo ! 38 USE in_out_manager ! I/O manager 39 USE iom ! NetCDF library 40 USE lib_mpp ! distribued memory computing library 41 USE wrk_nemo ! work arrays 42 USE timing ! Timing 43 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 44 USE eosbn2 45 USE sbcrnf , ONLY : l_rnfcpl 37 USE albedo ! 38 USE eosbn2 ! 39 USE sbcrnf , ONLY : l_rnfcpl 46 40 #if defined key_cpl_carbon_cycle 47 41 USE p4zflx, ONLY : oce_co2 … … 51 45 #endif 52 46 #if defined key_lim3 53 USE limthd_dh 47 USE limthd_dh ! for CALL lim_thd_snwblow 54 48 #endif 49 ! 50 USE in_out_manager ! I/O manager 51 USE iom ! NetCDF library 52 USE lib_mpp ! distribued memory computing library 53 USE wrk_nemo ! work arrays 54 USE timing ! Timing 55 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 55 56 56 57 IMPLICIT NONE 57 58 PRIVATE 58 59 59 PUBLIC sbc_cpl_init 60 PUBLIC sbc_cpl_rcv 61 PUBLIC sbc_cpl_snd 62 PUBLIC sbc_cpl_ice_tau 63 PUBLIC sbc_cpl_ice_flx 64 PUBLIC sbc_cpl_alloc 65 66 INTEGER, PARAMETER :: jpr_otx1 = 1 67 INTEGER, PARAMETER :: jpr_oty1 = 2 68 INTEGER, PARAMETER :: jpr_otz1 = 3 69 INTEGER, PARAMETER :: jpr_otx2 = 4 70 INTEGER, PARAMETER :: jpr_oty2 = 5 71 INTEGER, PARAMETER :: jpr_otz2 = 6 72 INTEGER, PARAMETER :: jpr_itx1 = 7 73 INTEGER, PARAMETER :: jpr_ity1 = 8 74 INTEGER, PARAMETER :: jpr_itz1 = 9 75 INTEGER, PARAMETER :: jpr_itx2 = 10 76 INTEGER, PARAMETER :: jpr_ity2 = 11 77 INTEGER, PARAMETER :: jpr_itz2 = 12 78 INTEGER, PARAMETER :: jpr_qsroce = 13 79 INTEGER, PARAMETER :: jpr_qsrice = 14 60 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 61 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90 62 PUBLIC sbc_cpl_snd ! routine called by step.F90 63 PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim(_2).F90 64 PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim(_2).F90 65 PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90 66 67 INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 1 68 INTEGER, PARAMETER :: jpr_oty1 = 2 ! 69 INTEGER, PARAMETER :: jpr_otz1 = 3 ! 70 INTEGER, PARAMETER :: jpr_otx2 = 4 ! 3 atmosphere-ocean stress components on grid 2 71 INTEGER, PARAMETER :: jpr_oty2 = 5 ! 72 INTEGER, PARAMETER :: jpr_otz2 = 6 ! 73 INTEGER, PARAMETER :: jpr_itx1 = 7 ! 3 atmosphere-ice stress components on grid 1 74 INTEGER, PARAMETER :: jpr_ity1 = 8 ! 75 INTEGER, PARAMETER :: jpr_itz1 = 9 ! 76 INTEGER, PARAMETER :: jpr_itx2 = 10 ! 3 atmosphere-ice stress components on grid 2 77 INTEGER, PARAMETER :: jpr_ity2 = 11 ! 78 INTEGER, PARAMETER :: jpr_itz2 = 12 ! 79 INTEGER, PARAMETER :: jpr_qsroce = 13 ! Qsr above the ocean 80 INTEGER, PARAMETER :: jpr_qsrice = 14 ! Qsr above the ice 80 81 INTEGER, PARAMETER :: jpr_qsrmix = 15 81 INTEGER, PARAMETER :: jpr_qnsoce = 16 82 INTEGER, PARAMETER :: jpr_qnsice = 17 82 INTEGER, PARAMETER :: jpr_qnsoce = 16 ! Qns above the ocean 83 INTEGER, PARAMETER :: jpr_qnsice = 17 ! Qns above the ice 83 84 INTEGER, PARAMETER :: jpr_qnsmix = 18 84 INTEGER, PARAMETER :: jpr_rain = 19 85 INTEGER, PARAMETER :: jpr_snow = 20 86 INTEGER, PARAMETER :: jpr_tevp = 21 87 INTEGER, PARAMETER :: jpr_ievp = 22 88 INTEGER, PARAMETER :: jpr_sbpr = 23 89 INTEGER, PARAMETER :: jpr_semp = 24 90 INTEGER, PARAMETER :: jpr_oemp = 25 91 INTEGER, PARAMETER :: jpr_w10m = 26 92 INTEGER, PARAMETER :: jpr_dqnsdt = 27 93 INTEGER, PARAMETER :: jpr_rnf = 28 94 INTEGER, PARAMETER :: jpr_cal = 29 95 INTEGER, PARAMETER :: jpr_taum = 30 85 INTEGER, PARAMETER :: jpr_rain = 19 ! total liquid precipitation (rain) 86 INTEGER, PARAMETER :: jpr_snow = 20 ! solid precipitation over the ocean (snow) 87 INTEGER, PARAMETER :: jpr_tevp = 21 ! total evaporation 88 INTEGER, PARAMETER :: jpr_ievp = 22 ! solid evaporation (sublimation) 89 INTEGER, PARAMETER :: jpr_sbpr = 23 ! sublimation - liquid precipitation - solid precipitation 90 INTEGER, PARAMETER :: jpr_semp = 24 ! solid freshwater budget (sublimation - snow) 91 INTEGER, PARAMETER :: jpr_oemp = 25 ! ocean freshwater budget (evap - precip) 92 INTEGER, PARAMETER :: jpr_w10m = 26 ! 10m wind 93 INTEGER, PARAMETER :: jpr_dqnsdt = 27 ! d(Q non solar)/d(temperature) 94 INTEGER, PARAMETER :: jpr_rnf = 28 ! runoffs 95 INTEGER, PARAMETER :: jpr_cal = 29 ! calving 96 INTEGER, PARAMETER :: jpr_taum = 30 ! wind stress module 96 97 INTEGER, PARAMETER :: jpr_co2 = 31 97 INTEGER, PARAMETER :: jpr_topm = 32 98 INTEGER, PARAMETER :: jpr_botm = 33 99 INTEGER, PARAMETER :: jpr_sflx = 34 100 INTEGER, PARAMETER :: jpr_toce = 35 101 INTEGER, PARAMETER :: jpr_soce = 36 102 INTEGER, PARAMETER :: jpr_ocx1 = 37 103 INTEGER, PARAMETER :: jpr_ocy1 = 38 104 INTEGER, PARAMETER :: jpr_ssh = 39 105 INTEGER, PARAMETER :: jpr_fice = 40 106 INTEGER, PARAMETER :: jpr_e3t1st = 41 107 INTEGER, PARAMETER :: jpr_fraqsr = 42 108 INTEGER, PARAMETER :: jpr_mslp = 43 109 INTEGER, PARAMETER :: jpr_hsig = 44 110 INTEGER, PARAMETER :: jpr_phioc = 45 111 INTEGER, PARAMETER :: jpr_sdrftx = 46 112 INTEGER, PARAMETER :: jpr_sdrfty = 47 113 INTEGER, PARAMETER :: jpr_wper = 48 114 INTEGER, PARAMETER :: jpr_wnum = 49 115 INTEGER, PARAMETER :: jpr_wstrf = 50 116 INTEGER, PARAMETER :: jpr_wdrag = 51 117 INTEGER, PARAMETER :: jprcv = 51 118 119 INTEGER, PARAMETER :: jps_fice = 1 120 INTEGER, PARAMETER :: jps_toce = 2 121 INTEGER, PARAMETER :: jps_tice = 3 122 INTEGER, PARAMETER :: jps_tmix = 4 123 INTEGER, PARAMETER :: jps_albice = 5 124 INTEGER, PARAMETER :: jps_albmix = 6 125 INTEGER, PARAMETER :: jps_hice = 7 126 INTEGER, PARAMETER :: jps_hsnw = 8 127 INTEGER, PARAMETER :: jps_ocx1 = 9 128 INTEGER, PARAMETER :: jps_ocy1 = 10 129 INTEGER, PARAMETER :: jps_ocz1 = 11 130 INTEGER, PARAMETER :: jps_ivx1 = 12 131 INTEGER, PARAMETER :: jps_ivy1 = 13 132 INTEGER, PARAMETER :: jps_ivz1 = 14 98 INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn 99 INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn 100 INTEGER, PARAMETER :: jpr_sflx = 34 ! salt flux 101 INTEGER, PARAMETER :: jpr_toce = 35 ! ocean temperature 102 INTEGER, PARAMETER :: jpr_soce = 36 ! ocean salinity 103 INTEGER, PARAMETER :: jpr_ocx1 = 37 ! ocean current on grid 1 104 INTEGER, PARAMETER :: jpr_ocy1 = 38 ! 105 INTEGER, PARAMETER :: jpr_ssh = 39 ! sea surface height 106 INTEGER, PARAMETER :: jpr_fice = 40 ! ice fraction 107 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 108 INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level 109 INTEGER, PARAMETER :: jpr_mslp = 43 ! mean sea level pressure 110 INTEGER, PARAMETER :: jpr_hsig = 44 ! Hsig 111 INTEGER, PARAMETER :: jpr_phioc = 45 ! Wave=>ocean energy flux 112 INTEGER, PARAMETER :: jpr_sdrftx = 46 ! Stokes drift on grid 1 113 INTEGER, PARAMETER :: jpr_sdrfty = 47 ! Stokes drift on grid 2 114 INTEGER, PARAMETER :: jpr_wper = 48 ! Mean wave period 115 INTEGER, PARAMETER :: jpr_wnum = 49 ! Mean wavenumber 116 INTEGER, PARAMETER :: jpr_wstrf = 50 ! Stress fraction adsorbed by waves 117 INTEGER, PARAMETER :: jpr_wdrag = 51 ! Neutral surface drag coefficient 118 INTEGER, PARAMETER :: jprcv = 51 ! total number of fields received 119 120 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere 121 INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature 122 INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature 123 INTEGER, PARAMETER :: jps_tmix = 4 ! mixed temperature (ocean+ice) 124 INTEGER, PARAMETER :: jps_albice = 5 ! ice albedo 125 INTEGER, PARAMETER :: jps_albmix = 6 ! mixed albedo 126 INTEGER, PARAMETER :: jps_hice = 7 ! ice thickness 127 INTEGER, PARAMETER :: jps_hsnw = 8 ! snow thickness 128 INTEGER, PARAMETER :: jps_ocx1 = 9 ! ocean current on grid 1 129 INTEGER, PARAMETER :: jps_ocy1 = 10 ! 130 INTEGER, PARAMETER :: jps_ocz1 = 11 ! 131 INTEGER, PARAMETER :: jps_ivx1 = 12 ! ice current on grid 1 132 INTEGER, PARAMETER :: jps_ivy1 = 13 ! 133 INTEGER, PARAMETER :: jps_ivz1 = 14 ! 133 134 INTEGER, PARAMETER :: jps_co2 = 15 134 INTEGER, PARAMETER :: jps_soce = 16 135 INTEGER, PARAMETER :: jps_ssh = 17 136 INTEGER, PARAMETER :: jps_qsroce = 18 137 INTEGER, PARAMETER :: jps_qnsoce = 19 138 INTEGER, PARAMETER :: jps_oemp = 20 139 INTEGER, PARAMETER :: jps_sflx = 21 140 INTEGER, PARAMETER :: jps_otx1 = 22 141 INTEGER, PARAMETER :: jps_oty1 = 23 142 INTEGER, PARAMETER :: jps_rnf = 24 143 INTEGER, PARAMETER :: jps_taum = 25 144 INTEGER, PARAMETER :: jps_fice2 = 26 145 INTEGER, PARAMETER :: jps_e3t1st = 27 146 INTEGER, PARAMETER :: jps_fraqsr = 28 147 INTEGER, PARAMETER :: jps_ficet = 29 148 INTEGER, PARAMETER :: jps_ocxw = 30 149 INTEGER, PARAMETER :: jps_ocyw = 31 150 INTEGER, PARAMETER :: jps_wlev = 32 151 INTEGER, PARAMETER :: jpsnd = 32 152 153 ! 154 TYPE :: FLD_C 155 CHARACTER(len = 32) :: cldes 156 CHARACTER(len = 32) :: clcat 157 CHARACTER(len = 32) :: clvref 158 CHARACTER(len = 32) :: clvor 159 CHARACTER(len = 32) :: clvgrd 135 INTEGER, PARAMETER :: jps_soce = 16 ! ocean salinity 136 INTEGER, PARAMETER :: jps_ssh = 17 ! sea surface height 137 INTEGER, PARAMETER :: jps_qsroce = 18 ! Qsr above the ocean 138 INTEGER, PARAMETER :: jps_qnsoce = 19 ! Qns above the ocean 139 INTEGER, PARAMETER :: jps_oemp = 20 ! ocean freshwater budget (evap - precip) 140 INTEGER, PARAMETER :: jps_sflx = 21 ! salt flux 141 INTEGER, PARAMETER :: jps_otx1 = 22 ! 2 atmosphere-ocean stress components on grid 1 142 INTEGER, PARAMETER :: jps_oty1 = 23 ! 143 INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs 144 INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module 145 INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling) 146 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 147 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level 148 INTEGER, PARAMETER :: jps_ficet = 29 ! total ice fraction 149 INTEGER, PARAMETER :: jps_ocxw = 30 ! currents on grid 1 150 INTEGER, PARAMETER :: jps_ocyw = 31 ! currents on grid 2 151 INTEGER, PARAMETER :: jps_wlev = 32 ! water level 152 INTEGER, PARAMETER :: jpsnd = 32 ! total number of fields sent 153 154 ! !!** namelist namsbc_cpl ** 155 TYPE :: FLD_C ! 156 CHARACTER(len = 32) :: cldes ! desciption of the coupling strategy 157 CHARACTER(len = 32) :: clcat ! multiple ice categories strategy 158 CHARACTER(len = 32) :: clvref ! reference of vector ('spherical' or 'cartesian') 159 CHARACTER(len = 32) :: clvor ! orientation of vector fields ('eastward-northward' or 'local grid') 160 CHARACTER(len = 32) :: clvgrd ! grids on which is located the vector fields 160 161 END TYPE FLD_C 161 ! Send to the atmosphere !162 ! ! Send to the atmosphere 162 163 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 163 ! Received from the atmosphere !164 ! ! Received from the atmosphere 164 165 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 165 166 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp … … 168 169 ! Received from waves 169 170 TYPE(FLD_C) :: sn_rcv_hsig,sn_rcv_phioc,sn_rcv_sdrfx,sn_rcv_sdrfy,sn_rcv_wper,sn_rcv_wnum,sn_rcv_wstrf,sn_rcv_wdrag 170 ! Other namelist parameters !171 INTEGER :: nn_cplmodel 172 LOGICAL :: ln_usecplmask 173 171 ! ! Other namelist parameters 172 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 173 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 174 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 174 175 TYPE :: DYNARR 175 176 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 176 177 END TYPE DYNARR 177 178 178 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv 179 180 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix 179 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere 180 181 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 181 182 182 183 REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2] … … 189 190 # include "vectopt_loop_substitute.h90" 190 191 !!---------------------------------------------------------------------- 191 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)192 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 192 193 !! $Id$ 193 194 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 194 195 !!---------------------------------------------------------------------- 195 196 196 CONTAINS 197 197 … … 232 232 !! * initialise the OASIS coupler 233 233 !!---------------------------------------------------------------------- 234 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 235 !! 236 INTEGER :: jn ! dummy loop index 237 INTEGER :: ios ! Local integer output status for namelist read 238 INTEGER :: inum 234 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 235 ! 236 INTEGER :: jn ! dummy loop index 237 INTEGER :: ios, inum ! Local integer 239 238 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 240 239 !! … … 247 246 !!--------------------------------------------------------------------- 248 247 ! 249 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init')250 ! 251 CALL wrk_alloc( jpi,jpj, zacs, zaos )248 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init') 249 ! 250 CALL wrk_alloc( jpi,jpj, zacs, zaos ) 252 251 253 252 ! ================================ ! 254 253 ! Namelist informations ! 255 254 ! ================================ ! 256 255 ! 257 256 REWIND( numnam_ref ) ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling 258 257 READ ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901) 259 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp )260 258 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp ) 259 ! 261 260 REWIND( numnam_cfg ) ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling 262 261 READ ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 ) 263 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp )262 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp ) 264 263 IF(lwm) WRITE ( numond, namsbc_cpl ) 265 264 ! 266 265 IF(lwp) THEN ! control print 267 266 WRITE(numout,*) … … 415 414 srcv(jpr_ity1)%clgrid = 'V' ! i.e. it is always at U- & V-points for i- & j-comp. resp. 416 415 ENDIF 417 ENDIF 418 416 419 417 ! ! ------------------------- ! 420 418 ! ! freshwater budget ! E-P … … 438 436 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 439 437 END SELECT 440 438 ! 441 439 ! ! ------------------------- ! 442 440 ! ! Runoffs & Calving ! … … 452 450 ! 453 451 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 454 452 ! 455 453 ! ! ------------------------- ! 456 454 ! ! non solar radiation ! Qns … … 627 625 IF( .NOT. ln_cpl ) srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling 628 626 srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE. 629 srcv( jpr_e3t1st )%laction = lk_vvl627 srcv( jpr_e3t1st )%laction = .NOT.ln_linssh 630 628 srcv(jpr_ocx1)%clgrid = 'U' ! oce components given at U-point 631 629 srcv(jpr_ocy1)%clgrid = 'V' ! and V-point … … 819 817 ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 820 818 ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE. 821 ssnd( jps_e3t1st )%laction = lk_vvl819 ssnd( jps_e3t1st )%laction = .NOT.ln_linssh 822 820 ! vector definition: not used but cleaner... 823 821 ssnd(jps_ocx1)%clgrid = 'U' ! oce components given at U-point … … 903 901 IF( ln_dm2dc .AND. ln_cpl ) ncpl_qsr_freq = 86400 / ncpl_qsr_freq 904 902 905 CALL wrk_dealloc( jpi,jpj, zacs, zaos )906 ! 907 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_init')903 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 904 ! 905 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_init') 908 906 ! 909 907 END SUBROUTINE sbc_cpl_init … … 962 960 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 963 961 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 964 965 962 !! 966 963 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 967 964 INTEGER :: ji, jj, jn ! dummy loop indices 968 INTEGER :: isec ! number of seconds since nit000 (assuming rdt tradid not change since nit000)965 INTEGER :: isec ! number of seconds since nit000 (assuming rdt did not change since nit000) 969 966 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 970 967 REAL(wp) :: zcoef ! temporary scalar … … 975 972 !!---------------------------------------------------------------------- 976 973 ! 977 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv')978 ! 979 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )974 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 975 ! 976 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 980 977 ! 981 978 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 984 981 ! ! Receive all the atmos. fields (including ice information) 985 982 ! ! ======================================================= ! 986 isec = ( kt - nit000 ) * NINT( rdt tra(1) )! date of exchanges983 isec = ( kt - nit000 ) * NINT( rdt ) ! date of exchanges 987 984 DO jn = 1, jprcv ! received fields sent by the atmosphere 988 985 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) … … 1188 1185 IF( srcv(jpr_toce)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1189 1186 sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1) 1190 IF( srcv(jpr_soce)%laction .AND. l n_useCT ) THEN ! make sure that sst_m is the potential temperature1187 IF( srcv(jpr_soce)%laction .AND. l_useCT ) THEN ! make sure that sst_m is the potential temperature 1191 1188 sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) ) 1192 1189 ENDIF … … 1205 1202 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1206 1203 ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1204 un (:,:,1) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1207 1205 CALL iom_put( 'ssu_m', ssu_m ) 1208 1206 ENDIF … … 1210 1208 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1211 1209 vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1210 vn (:,:,1) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1212 1211 CALL iom_put( 'ssv_m', ssv_m ) 1213 1212 ENDIF … … 1284 1283 IF( srcv(jpr_fice )%laction ) fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 1285 1284 ! 1286 1287 ENDIF 1288 ! 1289 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 1290 ! 1291 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') 1285 ENDIF 1286 ! 1287 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 1288 ! 1289 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') 1292 1290 ! 1293 1291 END SUBROUTINE sbc_cpl_rcv … … 1330 1328 REAL(wp), INTENT(out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) 1331 1329 !! 1332 INTEGER :: ji, jj 1333 INTEGER :: itx 1330 INTEGER :: ji, jj ! dummy loop indices 1331 INTEGER :: itx ! index of taux over ice 1334 1332 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty 1335 1333 !!---------------------------------------------------------------------- 1336 1334 ! 1337 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_tau')1338 ! 1339 CALL wrk_alloc( jpi,jpj, ztx, zty )1335 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_tau') 1336 ! 1337 CALL wrk_alloc( jpi,jpj, ztx, zty ) 1340 1338 1341 1339 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 … … 1345 1343 ! do something only if we just received the stress from atmosphere 1346 1344 IF( nrcvinfo(itx) == OASIS_Rcv ) THEN 1347 1348 1345 ! ! ======================= ! 1349 1346 IF( srcv(jpr_itx1)%laction ) THEN ! ice stress received ! … … 1498 1495 ENDIF 1499 1496 ! 1500 CALL wrk_dealloc( jpi,jpj, ztx, zty )1501 ! 1502 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_tau')1497 CALL wrk_dealloc( jpi,jpj, ztx, zty ) 1498 ! 1499 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_tau') 1503 1500 ! 1504 1501 END SUBROUTINE sbc_cpl_ice_tau … … 1509 1506 !! *** ROUTINE sbc_cpl_ice_flx *** 1510 1507 !! 1511 !! ** Purpose : provide the heat and freshwater fluxes of the 1512 !! ocean-ice system. 1508 !! ** Purpose : provide the heat and freshwater fluxes of the ocean-ice system 1513 1509 !! 1514 1510 !! ** Method : transform the fields received from the atmosphere into 1515 1511 !! surface heat and fresh water boundary condition for the 1516 1512 !! ice-ocean system. The following fields are provided: 1517 !! * total non solar, solar and freshwater fluxes (qns_tot,1513 !! * total non solar, solar and freshwater fluxes (qns_tot, 1518 1514 !! qsr_tot and emp_tot) (total means weighted ice-ocean flux) 1519 1515 !! NB: emp_tot include runoffs and calving. 1520 !! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where1516 !! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where 1521 1517 !! emp_ice = sublimation - solid precipitation as liquid 1522 1518 !! precipitation are re-routed directly to the ocean and 1523 !! runoffs and calving directly enter the ocean.1524 !! * solid precipitation (sprecip), used to add to qns_tot1519 !! calving directly enter the ocean (runoffs are read but included in trasbc.F90) 1520 !! * solid precipitation (sprecip), used to add to qns_tot 1525 1521 !! the heat lost associated to melting solid precipitation 1526 1522 !! over the ocean fraction. 1527 !! ===>> CAUTION here this changes the net heat flux received from 1528 !! the atmosphere 1529 !! 1530 !! - the fluxes have been separated from the stress as 1531 !! (a) they are updated at each ice time step compare to 1532 !! an update at each coupled time step for the stress, and 1533 !! (b) the conservative computation of the fluxes over the 1534 !! sea-ice area requires the knowledge of the ice fraction 1535 !! after the ice advection and before the ice thermodynamics, 1536 !! so that the stress is updated before the ice dynamics 1537 !! while the fluxes are updated after it. 1523 !! * heat content of rain, snow and evap can also be provided, 1524 !! otherwise heat flux associated with these mass flux are 1525 !! guessed (qemp_oce, qemp_ice) 1526 !! 1527 !! - the fluxes have been separated from the stress as 1528 !! (a) they are updated at each ice time step compare to 1529 !! an update at each coupled time step for the stress, and 1530 !! (b) the conservative computation of the fluxes over the 1531 !! sea-ice area requires the knowledge of the ice fraction 1532 !! after the ice advection and before the ice thermodynamics, 1533 !! so that the stress is updated before the ice dynamics 1534 !! while the fluxes are updated after it. 1535 !! 1536 !! ** Details 1537 !! qns_tot = pfrld * qns_oce + ( 1 - pfrld ) * qns_ice => provided 1538 !! + qemp_oce + qemp_ice => recalculated and added up to qns 1539 !! 1540 !! qsr_tot = pfrld * qsr_oce + ( 1 - pfrld ) * qsr_ice => provided 1541 !! 1542 !! emp_tot = emp_oce + emp_ice => calving is provided and added to emp_tot (and emp_oce) 1543 !! river runoff (rnf) is provided but not included here 1538 1544 !! 1539 1545 !! ** Action : update at each nf_ice time step: 1540 1546 !! qns_tot, qsr_tot non-solar and solar total heat fluxes 1541 1547 !! qns_ice, qsr_ice non-solar and solar heat fluxes over the ice 1542 !! emp_tot total evaporation - precipitation(liquid and solid) (-runoff)(-calving)1543 !! emp_ice 1544 !! dqns_ice 1545 !! sprecip 1548 !! emp_tot total evaporation - precipitation(liquid and solid) (-calving) 1549 !! emp_ice ice sublimation - solid precipitation over the ice 1550 !! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice 1551 !! sprecip solid precipitation over the ocean 1546 1552 !!---------------------------------------------------------------------- 1547 1553 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] … … 1552 1558 ! 1553 1559 INTEGER :: jl ! dummy loop index 1554 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk 1555 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, z sprecip, ztprecip, zqns_tot, zqsr_tot1556 REAL(wp), POINTER, DIMENSION(:,: ,:) :: zqns_ice, zqsr_ice, zdqns_ice1557 REAL(wp), POINTER, DIMENSION(:,: ) :: zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM31560 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk, zsnw 1561 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 1562 REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1563 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice 1558 1564 !!---------------------------------------------------------------------- 1559 1565 ! 1560 1566 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1561 1567 ! 1562 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1563 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1568 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1569 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1570 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1571 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 1564 1572 1565 1573 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1568 1576 ! 1569 1577 ! ! ========================= ! 1570 ! ! freshwater budget ! (emp )1578 ! ! freshwater budget ! (emp_tot) 1571 1579 ! ! ========================= ! 1572 1580 ! 1573 ! ! total Precipitation - total Evaporation (emp_tot)1574 ! ! solid precipitation - sublimation (emp_ice)1575 ! ! solid Precipitation (sprecip)1576 ! ! liquid + solid Precipitation (tprecip)1581 ! ! solid Precipitation (sprecip) 1582 ! ! liquid + solid Precipitation (tprecip) 1583 ! ! total Evaporation - total Precipitation (emp_tot) 1584 ! ! sublimation - solid precipitation (cell average) (emp_ice) 1577 1585 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1578 CASE( 'conservative' 1579 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here1580 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here1581 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)1582 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)1583 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) )! liquid precipitation1586 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1587 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1588 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1589 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1590 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:) 1591 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1584 1592 IF( iom_use('hflx_rain_cea') ) & 1585 CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1586 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) & 1587 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1593 & CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1588 1594 IF( iom_use('evap_ao_cea' ) ) & 1589 CALL iom_put( 'evap_ao_cea' , ztmp )! ice-free oce evap (cell average)1595 & CALL iom_put( 'evap_ao_cea' , frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! ice-free oce evap (cell average) 1590 1596 IF( iom_use('hflx_evap_cea') ) & 1591 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) )! heat flux from from evap (cell average)1592 CASE( 'oce and ice' 1597 & CALL iom_put( 'hflx_evap_cea', ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * zcptn(:,:) ) ! heat flux from from evap (cell average) 1598 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1593 1599 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1594 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1600 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:) 1595 1601 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1596 1602 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 1597 1603 END SELECT 1598 1604 1599 IF( iom_use('subl_ai_cea') ) & 1600 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1601 ! 1602 ! ! runoffs and calving (put in emp_tot) 1605 #if defined key_lim3 1606 ! zsnw = snow fraction over ice after wind blowing 1607 zsnw(:,:) = 0._wp ; CALL lim_thd_snwblow( p_frld, zsnw ) 1608 1609 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 1610 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip 1611 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) ! emp_oce = emp_tot - emp_ice 1612 1613 ! --- evaporation over ocean (used later for qemp) --- ! 1614 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1615 1616 ! --- evaporation over ice (kg/m2/s) --- ! 1617 zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) 1618 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 1619 ! therefore, sublimation is not redistributed over the ice categories in case no subgrid scale fluxes are provided by atm. 1620 zdevap_ice(:,:) = 0._wp 1621 1622 ! --- runoffs (included in emp later on) --- ! 1623 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1624 1625 ! --- calving (put in emp_tot and emp_oce) --- ! 1626 IF( srcv(jpr_cal)%laction ) THEN 1627 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1628 zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1) 1629 CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 1630 ENDIF 1631 1632 IF( ln_mixcpl ) THEN 1633 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1634 emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1635 emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:) 1636 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1637 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1638 DO jl=1,jpl 1639 evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:) * zmsk(:,:) 1640 devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:) 1641 ENDDO 1642 ELSE 1643 emp_tot(:,:) = zemp_tot(:,:) 1644 emp_ice(:,:) = zemp_ice(:,:) 1645 emp_oce(:,:) = zemp_oce(:,:) 1646 sprecip(:,:) = zsprecip(:,:) 1647 tprecip(:,:) = ztprecip(:,:) 1648 DO jl=1,jpl 1649 evap_ice (:,:,jl) = zevap_ice (:,:) 1650 devap_ice(:,:,jl) = zdevap_ice(:,:) 1651 ENDDO 1652 ENDIF 1653 1654 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1655 CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1656 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1657 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1658 #else 1659 ! runoffs and calving (put in emp_tot) 1603 1660 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1604 1661 IF( srcv(jpr_cal)%laction ) THEN … … 1619 1676 ENDIF 1620 1677 1621 CALL iom_put( 'snowpre' , sprecip ) ! Snow1622 IF( iom_use('snow_ao_cea') ) &1623 CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snowover ice-free ocean (cell average)1624 IF( iom_use('snow_ai_cea') ) &1625 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1678 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1679 CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1680 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1681 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1682 #endif 1626 1683 1627 1684 ! ! ========================= ! 1628 1685 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns) 1629 1686 ! ! ========================= ! 1630 CASE( 'oce only' ) 1631 zqns_tot(:,: 1632 CASE( 'conservative' ) 1633 zqns_tot(:,: 1687 CASE( 'oce only' ) ! the required field is directly provided 1688 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1689 CASE( 'conservative' ) ! the required fields are directly provided 1690 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1634 1691 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1635 1692 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1636 1693 ELSE 1637 ! Set all category values equal for the moment1638 1694 DO jl=1,jpl 1639 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1695 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal 1640 1696 ENDDO 1641 1697 ENDIF 1642 CASE( 'oce and ice' ) 1643 zqns_tot(:,: 1698 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1699 zqns_tot(:,:) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1644 1700 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1645 1701 DO jl=1,jpl … … 1648 1704 ENDDO 1649 1705 ELSE 1650 qns_tot(:,: 1706 qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1651 1707 DO jl=1,jpl 1652 1708 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) … … 1654 1710 ENDDO 1655 1711 ENDIF 1656 CASE( 'mixed oce-ice' ) 1712 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1657 1713 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1658 1714 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1659 1715 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1660 1716 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1661 & + pist(:,:,1)* zicefr(:,:) ) )1717 & + pist(:,:,1) * zicefr(:,:) ) ) 1662 1718 END SELECT 1663 1719 !!gm … … 1669 1725 !! similar job should be done for snow and precipitation temperature 1670 1726 ! 1671 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1672 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1673 zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 1674 IF( iom_use('hflx_cal_cea') ) & 1675 CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1676 ENDIF 1677 1678 ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 1679 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1680 1681 #if defined key_lim3 1682 CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1683 1684 ! --- evaporation --- ! 1685 ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation 1686 ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice 1687 ! but it is incoherent WITH the ice model 1688 DO jl=1,jpl 1689 evap_ice(:,:,jl) = 0._wp ! should be: frcv(jpr_ievp)%z3(:,:,1) 1690 ENDDO 1691 zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 1692 1693 ! --- evaporation minus precipitation --- ! 1694 emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:) 1695 1727 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1728 zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1729 ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean 1730 IF( iom_use('hflx_cal_cea') ) CALL iom_put( 'hflx_cal_cea', - frcv(jpr_cal)%z3(:,:,1) * lfus ) ! heat flux from calving 1731 ENDIF 1732 1733 #if defined key_lim3 1696 1734 ! --- non solar flux over ocean --- ! 1697 1735 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax … … 1699 1737 WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 1700 1738 1701 ! --- heat flux associated with emp --- !1702 z snw(:,:) = 0._wp1703 CALL lim_thd_snwblow( p_frld, zsnw ) ! snow distribution over ice after wind blowing1704 zqemp_oce(:,:) = - zevap(:,:) * p_frld(:,:) * zcptn(:,:) & ! evap1705 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip1706 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 1707 qemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap1708 & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice1709 1710 ! --- heat content ofprecip over ice in J/m3 (to be used in 1D-thermo) --- !1739 ! --- heat flux associated with emp (W/m2) --- ! 1740 zqemp_oce(:,:) = - zevap_oce(:,:) * zcptn(:,:) & ! evap 1741 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip 1742 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean + snow melting 1743 ! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1744 ! & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1745 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice (only) 1746 ! qevap_ice=0 since we consider Tice=0degC 1747 1748 ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1711 1749 zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 1712 1750 1713 ! --- total non solar flux --- ! 1714 zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:) 1751 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 1752 DO jl = 1, jpl 1753 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0degC 1754 END DO 1755 1756 ! --- total non solar flux (including evap/precip) --- ! 1757 zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:) 1715 1758 1716 1759 ! --- in case both coupled/forced are active, we must mix values --- ! … … 1719 1762 qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:) 1720 1763 DO jl=1,jpl 1721 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1764 qns_ice (:,:,jl) = qns_ice (:,:,jl) * xcplmask(:,:,0) + zqns_ice (:,:,jl)* zmsk(:,:) 1765 qevap_ice(:,:,jl) = qevap_ice(:,:,jl) * xcplmask(:,:,0) + zqevap_ice(:,:,jl)* zmsk(:,:) 1722 1766 ENDDO 1723 1767 qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:) 1724 1768 qemp_oce (:,:) = qemp_oce(:,:) * xcplmask(:,:,0) + zqemp_oce(:,:)* zmsk(:,:) 1725 !!clem evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0)1769 qemp_ice (:,:) = qemp_ice(:,:) * xcplmask(:,:,0) + zqemp_ice(:,:)* zmsk(:,:) 1726 1770 ELSE 1727 1771 qns_tot (:,: ) = zqns_tot (:,: ) 1728 1772 qns_oce (:,: ) = zqns_oce (:,: ) 1729 1773 qns_ice (:,:,:) = zqns_ice (:,:,:) 1730 qprec_ice(:,:) = zqprec_ice(:,:) 1731 qemp_oce (:,:) = zqemp_oce (:,:) 1732 ENDIF 1733 1734 CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1774 qevap_ice(:,:,:) = zqevap_ice(:,:,:) 1775 qprec_ice(:,: ) = zqprec_ice(:,: ) 1776 qemp_oce (:,: ) = zqemp_oce (:,: ) 1777 qemp_ice (:,: ) = zqemp_ice (:,: ) 1778 ENDIF 1779 1780 !! clem: we should output qemp_oce and qemp_ice (at least) 1781 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) ) ! heat flux from snow (cell average) 1782 !! these diags are not outputed yet 1783 !! IF( iom_use('hflx_rain_cea') ) CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * zcptn(:,:) ) ! heat flux from rain (cell average) 1784 !! IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put( 'hflx_snow_ao_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (cell average) 1785 !! IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put( 'hflx_snow_ai_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) * zsnw(:,:) ) ! heat flux from snow (cell average) 1786 1735 1787 #else 1736 1737 1788 ! clem: this formulation is certainly wrong... but better than it was... 1738 1789 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1739 1790 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting 1740 1791 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1741 & - zemp_ice(:,:) * zicefr(:,:)) * zcptn(:,:)1792 & - zemp_ice(:,:) ) * zcptn(:,:) 1742 1793 1743 1794 IF( ln_mixcpl ) THEN … … 1751 1802 qns_ice(:,:,:) = zqns_ice(:,:,:) 1752 1803 ENDIF 1753 1754 1804 #endif 1755 1805 … … 1802 1852 1803 1853 #if defined key_lim3 1804 CALL wrk_alloc( jpi,jpj, zqsr_oce )1805 1854 ! --- solar flux over ocean --- ! 1806 1855 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax … … 1810 1859 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) 1811 1860 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF 1812 1813 CALL wrk_dealloc( jpi,jpj, zqsr_oce )1814 1861 #endif 1815 1862 … … 1862 1909 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1863 1910 1864 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1865 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1866 ! 1867 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') 1911 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1912 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1913 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1914 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 1915 ! 1916 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') 1868 1917 ! 1869 1918 END SUBROUTINE sbc_cpl_ice_flx … … 1888 1937 !!---------------------------------------------------------------------- 1889 1938 ! 1890 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_snd')1891 ! 1892 CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )1893 CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 )1894 1895 isec = ( kt - nit000 ) * NINT( rdttra(1)) ! date of exchanges1939 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_snd') 1940 ! 1941 CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 1942 CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 1943 1944 isec = ( kt - nit000 ) * NINT( rdt ) ! date of exchanges 1896 1945 1897 1946 zfr_l(:,:) = 1.- fr_i(:,:) … … 1902 1951 1903 1952 IF ( nn_components == jp_iam_opa ) THEN 1904 ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of l n_useCT on the received part1953 ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 1905 1954 ELSE 1906 1955 ! we must send the surface potential temperature 1907 IF( l n_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )1956 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 1908 1957 ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem) 1909 1958 ENDIF … … 1919 1968 ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1920 1969 ELSEWHERE 1921 ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?)1970 ztmp3(:,:,1) = rt0 1922 1971 END WHERE 1923 1972 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) … … 1950 1999 ! ! ------------------------- ! 1951 2000 IF( ssnd(jps_albice)%laction ) THEN ! ice 1952 SELECT CASE( sn_snd_alb%cldes ) 1953 CASE( 'ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 1954 CASE( 'weighted ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1955 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 2001 SELECT CASE( sn_snd_alb%cldes ) 2002 CASE( 'ice' ) 2003 SELECT CASE( sn_snd_alb%clcat ) 2004 CASE( 'yes' ) 2005 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 2006 CASE( 'no' ) 2007 WHERE( SUM( a_i, dim=3 ) /= 0. ) 2008 ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 ) 2009 ELSEWHERE 2010 ztmp1(:,:) = albedo_oce_mix(:,:) 2011 END WHERE 2012 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' ) 2013 END SELECT 2014 CASE( 'weighted ice' ) ; 2015 SELECT CASE( sn_snd_alb%clcat ) 2016 CASE( 'yes' ) 2017 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2018 CASE( 'no' ) 2019 WHERE( fr_i (:,:) > 0. ) 2020 ztmp1(:,:) = SUM ( alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) 2021 ELSEWHERE 2022 ztmp1(:,:) = 0. 2023 END WHERE 2024 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' ) 2025 END SELECT 2026 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 1956 2027 END SELECT 1957 CALL cpl_snd( jps_albice, isec, ztmp3, info ) 1958 ENDIF 2028 2029 SELECT CASE( sn_snd_alb%clcat ) 2030 CASE( 'yes' ) 2031 CALL cpl_snd( jps_albice, isec, ztmp3, info ) !-> MV this has never been checked in coupled mode 2032 CASE( 'no' ) 2033 CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2034 END SELECT 2035 ENDIF 2036 1959 2037 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean 1960 2038 ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) … … 2326 2404 ! ! first T level thickness 2327 2405 IF( ssnd(jps_e3t1st )%laction ) THEN 2328 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1) , (/jpi,jpj,1/) ), info )2406 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t_n(:,:,1) , (/jpi,jpj,1/) ), info ) 2329 2407 ENDIF 2330 2408 ! ! Qsr fraction … … 2344 2422 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 2345 2423 2346 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )2347 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )2348 ! 2349 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_snd')2424 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 2425 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 2426 ! 2427 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_snd') 2350 2428 ! 2351 2429 END SUBROUTINE sbc_cpl_snd
Note: See TracChangeset
for help on using the changeset viewer.
