- Timestamp:
- 2015-12-16T10:25:22+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5836 r6060 18 18 !! sbc_cpl_snd : send fields to the atmosphere 19 19 !!---------------------------------------------------------------------- 20 USE dom_oce 21 USE sbc_oce 22 USE sbc_ice 23 USE sbcapr 24 USE sbcdcy 25 USE phycst 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 ! Stochastic param. : ??? 24 USE sbcdcy ! surface boundary condition: diurnal cycle 25 USE phycst ! physical constants 26 26 #if defined key_lim3 27 USE ice 27 USE ice ! ice variables 28 28 #endif 29 29 #if defined key_lim2 30 USE par_ice_2 31 USE ice_2 30 USE par_ice_2 ! ice parameters 31 USE ice_2 ! ice variables 32 32 #endif 33 USE cpl_oasis3 34 USE geo2ocean 33 USE cpl_oasis3 ! OASIS3 coupling 34 USE geo2ocean ! 35 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 36 USE albedo ! 37 USE eosbn2 ! 38 USE sbcrnf , ONLY : l_rnfcpl 45 39 #if defined key_cpl_carbon_cycle 46 40 USE p4zflx, ONLY : oce_co2 … … 50 44 #endif 51 45 #if defined key_lim3 52 USE limthd_dh 46 USE limthd_dh ! for CALL lim_thd_snwblow 53 47 #endif 48 ! 49 USE in_out_manager ! I/O manager 50 USE iom ! NetCDF library 51 USE lib_mpp ! distribued memory computing library 52 USE wrk_nemo ! work arrays 53 USE timing ! Timing 54 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 54 55 55 56 IMPLICIT NONE 56 57 PRIVATE 57 58 58 PUBLIC sbc_cpl_init 59 PUBLIC sbc_cpl_rcv 60 PUBLIC sbc_cpl_snd 61 PUBLIC sbc_cpl_ice_tau 62 PUBLIC sbc_cpl_ice_flx 63 PUBLIC sbc_cpl_alloc 64 65 INTEGER, PARAMETER :: jpr_otx1 = 1 66 INTEGER, PARAMETER :: jpr_oty1 = 2 67 INTEGER, PARAMETER :: jpr_otz1 = 3 68 INTEGER, PARAMETER :: jpr_otx2 = 4 69 INTEGER, PARAMETER :: jpr_oty2 = 5 70 INTEGER, PARAMETER :: jpr_otz2 = 6 71 INTEGER, PARAMETER :: jpr_itx1 = 7 72 INTEGER, PARAMETER :: jpr_ity1 = 8 73 INTEGER, PARAMETER :: jpr_itz1 = 9 74 INTEGER, PARAMETER :: jpr_itx2 = 10 75 INTEGER, PARAMETER :: jpr_ity2 = 11 76 INTEGER, PARAMETER :: jpr_itz2 = 12 77 INTEGER, PARAMETER :: jpr_qsroce = 13 78 INTEGER, PARAMETER :: jpr_qsrice = 14 59 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 60 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90 61 PUBLIC sbc_cpl_snd ! routine called by step.F90 62 PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim(_2).F90 63 PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim(_2).F90 64 PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90 65 66 INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 1 67 INTEGER, PARAMETER :: jpr_oty1 = 2 ! 68 INTEGER, PARAMETER :: jpr_otz1 = 3 ! 69 INTEGER, PARAMETER :: jpr_otx2 = 4 ! 3 atmosphere-ocean stress components on grid 2 70 INTEGER, PARAMETER :: jpr_oty2 = 5 ! 71 INTEGER, PARAMETER :: jpr_otz2 = 6 ! 72 INTEGER, PARAMETER :: jpr_itx1 = 7 ! 3 atmosphere-ice stress components on grid 1 73 INTEGER, PARAMETER :: jpr_ity1 = 8 ! 74 INTEGER, PARAMETER :: jpr_itz1 = 9 ! 75 INTEGER, PARAMETER :: jpr_itx2 = 10 ! 3 atmosphere-ice stress components on grid 2 76 INTEGER, PARAMETER :: jpr_ity2 = 11 ! 77 INTEGER, PARAMETER :: jpr_itz2 = 12 ! 78 INTEGER, PARAMETER :: jpr_qsroce = 13 ! Qsr above the ocean 79 INTEGER, PARAMETER :: jpr_qsrice = 14 ! Qsr above the ice 79 80 INTEGER, PARAMETER :: jpr_qsrmix = 15 80 INTEGER, PARAMETER :: jpr_qnsoce = 16 81 INTEGER, PARAMETER :: jpr_qnsice = 17 81 INTEGER, PARAMETER :: jpr_qnsoce = 16 ! Qns above the ocean 82 INTEGER, PARAMETER :: jpr_qnsice = 17 ! Qns above the ice 82 83 INTEGER, PARAMETER :: jpr_qnsmix = 18 83 INTEGER, PARAMETER :: jpr_rain = 19 84 INTEGER, PARAMETER :: jpr_snow = 20 85 INTEGER, PARAMETER :: jpr_tevp = 21 86 INTEGER, PARAMETER :: jpr_ievp = 22 87 INTEGER, PARAMETER :: jpr_sbpr = 23 88 INTEGER, PARAMETER :: jpr_semp = 24 89 INTEGER, PARAMETER :: jpr_oemp = 25 90 INTEGER, PARAMETER :: jpr_w10m = 26 91 INTEGER, PARAMETER :: jpr_dqnsdt = 27 92 INTEGER, PARAMETER :: jpr_rnf = 28 93 INTEGER, PARAMETER :: jpr_cal = 29 94 INTEGER, PARAMETER :: jpr_taum = 30 84 INTEGER, PARAMETER :: jpr_rain = 19 ! total liquid precipitation (rain) 85 INTEGER, PARAMETER :: jpr_snow = 20 ! solid precipitation over the ocean (snow) 86 INTEGER, PARAMETER :: jpr_tevp = 21 ! total evaporation 87 INTEGER, PARAMETER :: jpr_ievp = 22 ! solid evaporation (sublimation) 88 INTEGER, PARAMETER :: jpr_sbpr = 23 ! sublimation - liquid precipitation - solid precipitation 89 INTEGER, PARAMETER :: jpr_semp = 24 ! solid freshwater budget (sublimation - snow) 90 INTEGER, PARAMETER :: jpr_oemp = 25 ! ocean freshwater budget (evap - precip) 91 INTEGER, PARAMETER :: jpr_w10m = 26 ! 10m wind 92 INTEGER, PARAMETER :: jpr_dqnsdt = 27 ! d(Q non solar)/d(temperature) 93 INTEGER, PARAMETER :: jpr_rnf = 28 ! runoffs 94 INTEGER, PARAMETER :: jpr_cal = 29 ! calving 95 INTEGER, PARAMETER :: jpr_taum = 30 ! wind stress module 95 96 INTEGER, PARAMETER :: jpr_co2 = 31 96 INTEGER, PARAMETER :: jpr_topm = 32 97 INTEGER, PARAMETER :: jpr_botm = 33 98 INTEGER, PARAMETER :: jpr_sflx = 34 99 INTEGER, PARAMETER :: jpr_toce = 35 100 INTEGER, PARAMETER :: jpr_soce = 36 101 INTEGER, PARAMETER :: jpr_ocx1 = 37 102 INTEGER, PARAMETER :: jpr_ocy1 = 38 103 INTEGER, PARAMETER :: jpr_ssh = 39 104 INTEGER, PARAMETER :: jpr_fice = 40 105 INTEGER, PARAMETER :: jpr_e3t1st = 41 106 INTEGER, PARAMETER :: jpr_fraqsr = 42 107 INTEGER, PARAMETER :: jprcv = 42 108 109 INTEGER, PARAMETER :: jps_fice = 1 110 INTEGER, PARAMETER :: jps_toce = 2 111 INTEGER, PARAMETER :: jps_tice = 3 112 INTEGER, PARAMETER :: jps_tmix = 4 113 INTEGER, PARAMETER :: jps_albice = 5 114 INTEGER, PARAMETER :: jps_albmix = 6 115 INTEGER, PARAMETER :: jps_hice = 7 116 INTEGER, PARAMETER :: jps_hsnw = 8 117 INTEGER, PARAMETER :: jps_ocx1 = 9 118 INTEGER, PARAMETER :: jps_ocy1 = 10 119 INTEGER, PARAMETER :: jps_ocz1 = 11 120 INTEGER, PARAMETER :: jps_ivx1 = 12 121 INTEGER, PARAMETER :: jps_ivy1 = 13 122 INTEGER, PARAMETER :: jps_ivz1 = 14 97 INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn 98 INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn 99 INTEGER, PARAMETER :: jpr_sflx = 34 ! salt flux 100 INTEGER, PARAMETER :: jpr_toce = 35 ! ocean temperature 101 INTEGER, PARAMETER :: jpr_soce = 36 ! ocean salinity 102 INTEGER, PARAMETER :: jpr_ocx1 = 37 ! ocean current on grid 1 103 INTEGER, PARAMETER :: jpr_ocy1 = 38 ! 104 INTEGER, PARAMETER :: jpr_ssh = 39 ! sea surface height 105 INTEGER, PARAMETER :: jpr_fice = 40 ! ice fraction 106 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 107 INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level 108 INTEGER, PARAMETER :: jprcv = 42 ! total number of fields received 109 110 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere 111 INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature 112 INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature 113 INTEGER, PARAMETER :: jps_tmix = 4 ! mixed temperature (ocean+ice) 114 INTEGER, PARAMETER :: jps_albice = 5 ! ice albedo 115 INTEGER, PARAMETER :: jps_albmix = 6 ! mixed albedo 116 INTEGER, PARAMETER :: jps_hice = 7 ! ice thickness 117 INTEGER, PARAMETER :: jps_hsnw = 8 ! snow thickness 118 INTEGER, PARAMETER :: jps_ocx1 = 9 ! ocean current on grid 1 119 INTEGER, PARAMETER :: jps_ocy1 = 10 ! 120 INTEGER, PARAMETER :: jps_ocz1 = 11 ! 121 INTEGER, PARAMETER :: jps_ivx1 = 12 ! ice current on grid 1 122 INTEGER, PARAMETER :: jps_ivy1 = 13 ! 123 INTEGER, PARAMETER :: jps_ivz1 = 14 ! 123 124 INTEGER, PARAMETER :: jps_co2 = 15 124 INTEGER, PARAMETER :: jps_soce = 16 125 INTEGER, PARAMETER :: jps_ssh = 17 126 INTEGER, PARAMETER :: jps_qsroce = 18 127 INTEGER, PARAMETER :: jps_qnsoce = 19 128 INTEGER, PARAMETER :: jps_oemp = 20 129 INTEGER, PARAMETER :: jps_sflx = 21 130 INTEGER, PARAMETER :: jps_otx1 = 22 131 INTEGER, PARAMETER :: jps_oty1 = 23 132 INTEGER, PARAMETER :: jps_rnf = 24 133 INTEGER, PARAMETER :: jps_taum = 25 134 INTEGER, PARAMETER :: jps_fice2 = 26 135 INTEGER, PARAMETER :: jps_e3t1st = 27 136 INTEGER, PARAMETER :: jps_fraqsr = 28 137 INTEGER, PARAMETER :: jpsnd = 28 138 139 ! 140 TYPE :: FLD_C 141 CHARACTER(len = 32) :: cldes 142 CHARACTER(len = 32) :: clcat 143 CHARACTER(len = 32) :: clvref 144 CHARACTER(len = 32) :: clvor 145 CHARACTER(len = 32) :: clvgrd 125 INTEGER, PARAMETER :: jps_soce = 16 ! ocean salinity 126 INTEGER, PARAMETER :: jps_ssh = 17 ! sea surface height 127 INTEGER, PARAMETER :: jps_qsroce = 18 ! Qsr above the ocean 128 INTEGER, PARAMETER :: jps_qnsoce = 19 ! Qns above the ocean 129 INTEGER, PARAMETER :: jps_oemp = 20 ! ocean freshwater budget (evap - precip) 130 INTEGER, PARAMETER :: jps_sflx = 21 ! salt flux 131 INTEGER, PARAMETER :: jps_otx1 = 22 ! 2 atmosphere-ocean stress components on grid 1 132 INTEGER, PARAMETER :: jps_oty1 = 23 ! 133 INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs 134 INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module 135 INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling) 136 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 137 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level 138 INTEGER, PARAMETER :: jpsnd = 28 ! total number of fields sended 139 140 ! !!** namelist namsbc_cpl ** 141 TYPE :: FLD_C ! 142 CHARACTER(len = 32) :: cldes ! desciption of the coupling strategy 143 CHARACTER(len = 32) :: clcat ! multiple ice categories strategy 144 CHARACTER(len = 32) :: clvref ! reference of vector ('spherical' or 'cartesian') 145 CHARACTER(len = 32) :: clvor ! orientation of vector fields ('eastward-northward' or 'local grid') 146 CHARACTER(len = 32) :: clvgrd ! grids on which is located the vector fields 146 147 END TYPE FLD_C 147 ! Send to the atmosphere !148 ! ! Send to the atmosphere 148 149 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 149 ! Received from the atmosphere !150 ! ! Received from the atmosphere 150 151 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 151 152 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 152 ! Other namelist parameters !153 INTEGER :: nn_cplmodel 154 LOGICAL :: ln_usecplmask 155 153 ! ! Other namelist parameters 154 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 155 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 156 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 156 157 TYPE :: DYNARR 157 158 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 158 159 END TYPE DYNARR 159 160 160 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv 161 162 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix 163 164 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo 161 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere 162 163 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 164 165 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument 165 166 166 167 !! Substitution 167 # include "domzgr_substitute.h90"168 168 # include "vectopt_loop_substitute.h90" 169 169 !!---------------------------------------------------------------------- 170 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)170 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 171 171 !! $Id$ 172 172 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 173 173 !!---------------------------------------------------------------------- 174 175 174 CONTAINS 176 175 … … 209 208 !! * initialise the OASIS coupler 210 209 !!---------------------------------------------------------------------- 211 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 212 !! 213 INTEGER :: jn ! dummy loop index 214 INTEGER :: ios ! Local integer output status for namelist read 215 INTEGER :: inum 210 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 211 ! 212 INTEGER :: jn ! dummy loop index 213 INTEGER :: ios, inum ! Local integer 216 214 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 217 215 !! … … 222 220 !!--------------------------------------------------------------------- 223 221 ! 224 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init')225 ! 226 CALL wrk_alloc( jpi,jpj, zacs, zaos )222 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init') 223 ! 224 CALL wrk_alloc( jpi,jpj, zacs, zaos ) 227 225 228 226 ! ================================ ! 229 227 ! Namelist informations ! 230 228 ! ================================ ! 231 229 ! 232 230 REWIND( numnam_ref ) ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling 233 231 READ ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901) 234 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp )235 232 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp ) 233 ! 236 234 REWIND( numnam_cfg ) ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling 237 235 READ ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 ) 238 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp )236 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp ) 239 237 IF(lwm) WRITE ( numond, namsbc_cpl ) 240 238 ! 241 239 IF(lwp) THEN ! control print 242 240 WRITE(numout,*) … … 374 372 srcv(jpr_ity1)%clgrid = 'V' ! i.e. it is always at U- & V-points for i- & j-comp. resp. 375 373 ENDIF 376 374 ! 377 375 ! ! ------------------------- ! 378 376 ! ! freshwater budget ! E-P … … 396 394 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 397 395 END SELECT 398 396 ! 399 397 ! ! ------------------------- ! 400 398 ! ! Runoffs & Calving ! … … 410 408 ! 411 409 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 412 410 ! 413 411 ! ! ------------------------- ! 414 412 ! ! non solar radiation ! Qns … … 535 533 IF( .NOT. ln_cpl ) srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling 536 534 srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE. 537 srcv( jpr_e3t1st )%laction = lk_vvl535 srcv( jpr_e3t1st )%laction = .NOT.ln_linssh 538 536 srcv(jpr_ocx1)%clgrid = 'U' ! oce components given at U-point 539 537 srcv(jpr_ocy1)%clgrid = 'V' ! and V-point … … 701 699 ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 702 700 ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE. 703 ssnd( jps_e3t1st )%laction = lk_vvl701 ssnd( jps_e3t1st )%laction = .NOT.ln_linssh 704 702 ! vector definition: not used but cleaner... 705 703 ssnd(jps_ocx1)%clgrid = 'U' ! oce components given at U-point … … 785 783 ncpl_qsr_freq = 86400 / ncpl_qsr_freq 786 784 787 CALL wrk_dealloc( jpi,jpj, zacs, zaos )788 ! 789 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_init')785 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 786 ! 787 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_init') 790 788 ! 791 789 END SUBROUTINE sbc_cpl_init … … 837 835 !! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 838 836 !!---------------------------------------------------------------------- 839 INTEGER, INTENT(in) :: kt! ocean model time step index840 INTEGER, INTENT(in) :: k_fsbc! frequency of sbc (-> ice model) computation841 INTEGER, INTENT(in) :: k_ice! ice management in the sbc (=0/1/2/3)837 INTEGER, INTENT(in) :: kt ! ocean model time step index 838 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 839 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 842 840 843 841 !! … … 853 851 !!---------------------------------------------------------------------- 854 852 ! 855 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv')856 ! 857 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )853 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 854 ! 855 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 858 856 ! 859 857 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1104 1102 IF( srcv(jpr_fice )%laction ) fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 1105 1103 ! 1106 1107 ENDIF 1108 ! 1109 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 1110 ! 1111 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') 1104 ENDIF 1105 ! 1106 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 1107 ! 1108 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') 1112 1109 ! 1113 1110 END SUBROUTINE sbc_cpl_rcv … … 1150 1147 REAL(wp), INTENT(out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) 1151 1148 !! 1152 INTEGER :: ji, jj 1153 INTEGER :: itx 1149 INTEGER :: ji, jj ! dummy loop indices 1150 INTEGER :: itx ! index of taux over ice 1154 1151 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty 1155 1152 !!---------------------------------------------------------------------- 1156 1153 ! 1157 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_tau')1158 ! 1159 CALL wrk_alloc( jpi,jpj, ztx, zty )1154 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_tau') 1155 ! 1156 CALL wrk_alloc( jpi,jpj, ztx, zty ) 1160 1157 1161 1158 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 … … 1165 1162 ! do something only if we just received the stress from atmosphere 1166 1163 IF( nrcvinfo(itx) == OASIS_Rcv ) THEN 1167 1168 1164 ! ! ======================= ! 1169 1165 IF( srcv(jpr_itx1)%laction ) THEN ! ice stress received ! … … 1318 1314 ENDIF 1319 1315 ! 1320 CALL wrk_dealloc( jpi,jpj, ztx, zty )1321 ! 1322 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_tau')1316 CALL wrk_dealloc( jpi,jpj, ztx, zty ) 1317 ! 1318 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_tau') 1323 1319 ! 1324 1320 END SUBROUTINE sbc_cpl_ice_tau … … 1365 1361 !! sprecip solid precipitation over the ocean 1366 1362 !!---------------------------------------------------------------------- 1367 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction[0 to 1]1363 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1368 1364 ! optional arguments, used only in 'mixed oce-ice' case 1369 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi 1370 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature[Celsius]1371 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature[Kelvin]1372 ! 1373 INTEGER :: jl 1365 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1366 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1367 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1368 ! 1369 INTEGER :: jl ! dummy loop index 1374 1370 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk 1375 1371 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot … … 1378 1374 !!---------------------------------------------------------------------- 1379 1375 ! 1380 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx')1381 ! 1382 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )1383 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice )1376 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1377 ! 1378 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1379 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1384 1380 1385 1381 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1554 1550 CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1555 1551 #else 1556 1557 ! clem: this formulation is certainly wrong... but better than it was ...1552 ! 1553 ! clem: this formulation is certainly wrong... but better than it was before... 1558 1554 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1559 1555 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting … … 1571 1567 qns_ice(:,:,:) = zqns_ice(:,:,:) 1572 1568 ENDIF 1573 1569 ! 1574 1570 #endif 1575 1576 1571 ! ! ========================= ! 1577 1572 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr) … … 1682 1677 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1683 1678 1684 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )1685 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice )1686 ! 1687 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx')1679 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1680 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1681 ! 1682 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') 1688 1683 ! 1689 1684 END SUBROUTINE sbc_cpl_ice_flx … … 1708 1703 !!---------------------------------------------------------------------- 1709 1704 ! 1710 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_snd')1711 ! 1712 CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )1713 CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 )1705 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_snd') 1706 ! 1707 CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 1708 CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 1714 1709 1715 1710 isec = ( kt - nit000 ) * NINT(rdttra(1)) ! date of exchanges … … 2002 1997 ! ! first T level thickness 2003 1998 IF( ssnd(jps_e3t1st )%laction ) THEN 2004 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1) , (/jpi,jpj,1/) ), info )1999 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t_n(:,:,1) , (/jpi,jpj,1/) ), info ) 2005 2000 ENDIF 2006 2001 ! ! Qsr fraction … … 2020 2015 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 2021 2016 2022 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )2023 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )2024 ! 2025 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_snd')2017 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 2018 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 2019 ! 2020 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_snd') 2026 2021 ! 2027 2022 END SUBROUTINE sbc_cpl_snd
Note: See TracChangeset
for help on using the changeset viewer.
