- Timestamp:
- 2015-12-04T17:05:58+01:00 (8 years ago)
- Location:
- branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 14 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r5883 r6004 16 16 USE dom_oce ! ocean space and time domain 17 17 USE phycst ! physical constant 18 USE sbc_oce ! surface boundary conditions : fields 19 USE geo2ocean ! for vector rotation on to model grid 20 ! 18 21 USE in_out_manager ! I/O manager 19 22 USE iom ! I/O manager library 20 USE geo2ocean ! for vector rotation on to model grid23 USE ioipsl , ONLY : ymds2ju, ju2ymds ! for calendar 21 24 USE lib_mpp ! MPP library 22 25 USE wrk_nemo ! work arrays 23 26 USE lbclnk ! ocean lateral boundary conditions (C1D case) 24 USE ioipsl, ONLY : ymds2ju, ju2ymds ! for calendar25 USE sbc_oce26 27 27 28 IMPLICIT NONE … … 134 135 ! ! kt_offset = +1 => fields at "after" time level 135 136 ! ! etc. 136 ! 137 INTEGER :: itmp ! temporary variable 137 INTEGER :: itmp ! local variable 138 138 INTEGER :: imf ! size of the structure sd 139 139 INTEGER :: jf ! dummy indices -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
r5883 r6004 113 113 END SELECT 114 114 CASE DEFAULT ; CALL ctl_stop( 'rot_rep: Syntax Error in the definition of cdtodo' ) 115 ! 115 116 END SELECT 116 117 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
r5845 r6004 12 12 USE dom_oce ! ocean space and time domain 13 13 USE sbc_oce ! surface boundary condition 14 USE dynspg_oce ! surface pressure gradient variables15 14 USE phycst ! physical constants 15 ! 16 16 USE fldread ! read input fields 17 17 USE in_out_manager ! I/O manager … … 110 110 IF(lwp) WRITE(numout,*) ' Inverse barometer added to OBC ssh data' 111 111 ENDIF 112 IF( ( ln_apr_obc ) .AND. .NOT. lk_dynspg_ts ) & 113 CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' ) 114 IF( ( ln_apr_obc ) .AND. .NOT. ln_apr_dyn ) & 112 !jc: stop below should rather be a warning 113 IF( ln_apr_obc .AND. .NOT.ln_apr_dyn ) & 115 114 CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' ) 116 115 ENDIF -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r5845 r6004 19 19 20 20 !!---------------------------------------------------------------------- 21 !! sbc_blk_core 22 !! blk_oce_core 23 !! blk_ice_core 24 !! turb_core_2z 25 !! cd_neutral_10m 26 !! psi_m 27 !! psi_h 21 !! sbc_blk_core : bulk formulation as ocean surface boundary condition (forced mode, CORE bulk formulea) 22 !! blk_oce_core : computes momentum, heat and freshwater fluxes over ocean 23 !! blk_ice_core : computes momentum, heat and freshwater fluxes over ice 24 !! turb_core_2z : Computes turbulent transfert coefficients 25 !! cd_neutral_10m: Estimate of the neutral drag coefficient at 10m 26 !! psi_m : universal profile stability function for momentum 27 !! psi_h : universal profile stability function for temperature and humidity 28 28 !!---------------------------------------------------------------------- 29 USE oce ! ocean dynamics and tracers 30 USE dom_oce ! ocean space and time domain 31 USE phycst ! physical constants 32 USE fldread ! read input fields 33 USE sbc_oce ! Surface boundary condition: ocean fields 34 USE cyclone ! Cyclone 10m wind form trac of cyclone centres 35 USE sbcdcy ! surface boundary condition: diurnal cycle 36 USE iom ! I/O manager library 37 USE in_out_manager ! I/O manager 38 USE lib_mpp ! distribued memory computing library 39 USE wrk_nemo ! work arrays 40 USE timing ! Timing 41 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 42 USE prtctl ! Print control 43 USE sbcwave, ONLY : cdn_wave ! wave module 44 USE sbc_ice ! Surface boundary condition: ice fields 45 USE lib_fortran ! to use key_nosignedzero 29 USE oce ! ocean dynamics and tracers 30 USE dom_oce ! ocean space and time domain 31 USE phycst ! physical constants 32 USE fldread ! read input fields 33 USE sbc_oce ! Surface boundary condition: ocean fields 34 USE cyclone ! Cyclone 10m wind form trac of cyclone centres 35 USE sbcdcy ! surface boundary condition: diurnal cycle 36 USE sbcwave , ONLY : cdn_wave ! wave module 37 USE sbc_ice ! Surface boundary condition: ice fields 38 USE lib_fortran ! to use key_nosignedzero 46 39 #if defined key_lim3 47 USE ice , ONLY :u_ice, v_ice, jpl, pfrld, a_i_b48 USE limthd_dh 40 USE ice , ONLY : u_ice, v_ice, jpl, pfrld, a_i_b 41 USE limthd_dh ! for CALL lim_thd_snwblow 49 42 #elif defined key_lim2 50 USE ice_2 , ONLY :u_ice, v_ice51 USE par_ice_2 43 USE ice_2 , ONLY : u_ice, v_ice 44 USE par_ice_2 ! LIM-2 parameters 52 45 #endif 46 ! 47 USE iom ! I/O manager library 48 USE in_out_manager ! I/O manager 49 USE lib_mpp ! distribued memory computing library 50 USE wrk_nemo ! work arrays 51 USE timing ! Timing 52 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 53 USE prtctl ! Print control 53 54 54 55 IMPLICIT NONE … … 84 85 REAL(wp), PARAMETER :: albo = 0.066 ! ocean albedo assumed to be constant 85 86 86 ! 87 ! !!* Namelist namsbc_core : CORE bulk parameters 87 88 LOGICAL :: ln_taudif ! logical flag to use the "mean of stress module - module of mean stress" data 88 89 REAL(wp) :: rn_pfac ! multiplication factor for precipitation … … 148 149 TYPE(FLD_N) :: sn_tdif ! " " 149 150 NAMELIST/namsbc_core/ cn_dir , ln_taudif, rn_pfac, rn_efac, rn_vfac, & 150 & sn_wndi, sn_wndj , sn_humi, sn_qsr , &151 & sn_qlw , sn_tair , sn_prec, sn_snow, &152 & sn_tdif, rn_zqt , rn_zu151 & sn_wndi, sn_wndj , sn_humi, sn_qsr , & 152 & sn_qlw , sn_tair , sn_prec, sn_snow, & 153 & sn_tdif, rn_zqt , rn_zu 153 154 !!--------------------------------------------------------------------- 154 155 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90
r5845 r6004 8 8 9 9 !!---------------------------------------------------------------------- 10 !! sbc_blk_mfs : bulk formulation as ocean surface boundary condition10 !! sbc_blk_mfs : bulk formulation as ocean surface boundary condition 11 11 !! (forced mode, mfs bulk formulae) 12 !! blk_oce_mfs : ocean: computes momentum, heat and freshwater fluxes12 !! blk_oce_mfs : ocean: computes momentum, heat and freshwater fluxes 13 13 !!---------------------------------------------------------------------- 14 USE oce ! ocean dynamics and tracers 15 USE dom_oce ! ocean space and time domain 16 USE phycst ! physical constants 17 USE fldread ! read input fields 18 USE sbc_oce ! Surface boundary condition: ocean fields 19 USE iom ! I/O manager library 20 USE in_out_manager ! I/O manager 21 USE lib_mpp ! distribued memory computing library 22 USE wrk_nemo ! work arrays 23 USE timing ! Timing 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 USE prtctl ! Print control 26 USE sbcwave,ONLY : cdn_wave !wave module 14 USE oce ! ocean dynamics and tracers 15 USE dom_oce ! ocean space and time domain 16 USE phycst ! physical constants 17 USE fldread ! read input fields 18 USE sbc_oce ! Surface boundary condition: ocean fields 19 USE sbcwave ,ONLY : cdn_wave !wave module 20 ! 21 USE iom ! I/O manager library 22 USE in_out_manager ! I/O manager 23 USE lib_mpp ! distribued memory computing library 24 USE wrk_nemo ! work arrays 25 USE timing ! Timing 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 27 USE prtctl ! Print control 27 28 28 29 IMPLICIT NONE … … 48 49 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 49 50 !!---------------------------------------------------------------------- 50 51 51 CONTAINS 52 53 52 54 53 SUBROUTINE sbc_blk_mfs( kt ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5866 r6004 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 168 # include "vectopt_loop_substitute.h90" 168 169 !!---------------------------------------------------------------------- 169 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)170 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 170 171 !! $Id$ 171 172 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 172 173 !!---------------------------------------------------------------------- 173 174 174 CONTAINS 175 175 … … 208 208 !! * initialise the OASIS coupler 209 209 !!---------------------------------------------------------------------- 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 ! Local integer output status for namelist read 214 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 215 214 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 216 215 !! … … 221 220 !!--------------------------------------------------------------------- 222 221 ! 223 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init')224 ! 225 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 ) 226 225 227 226 ! ================================ ! 228 227 ! Namelist informations ! 229 228 ! ================================ ! 230 229 ! 231 230 REWIND( numnam_ref ) ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling 232 231 READ ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901) 233 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp )234 232 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp ) 233 ! 235 234 REWIND( numnam_cfg ) ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling 236 235 READ ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 ) 237 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 ) 238 237 IF(lwm) WRITE ( numond, namsbc_cpl ) 239 238 ! 240 239 IF(lwp) THEN ! control print 241 240 WRITE(numout,*) … … 373 372 srcv(jpr_ity1)%clgrid = 'V' ! i.e. it is always at U- & V-points for i- & j-comp. resp. 374 373 ENDIF 375 374 ! 376 375 ! ! ------------------------- ! 377 376 ! ! freshwater budget ! E-P … … 395 394 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 396 395 END SELECT 397 396 ! 398 397 ! ! ------------------------- ! 399 398 ! ! Runoffs & Calving ! … … 409 408 ! 410 409 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 411 410 ! 412 411 ! ! ------------------------- ! 413 412 ! ! non solar radiation ! Qns … … 784 783 ncpl_qsr_freq = 86400 / ncpl_qsr_freq 785 784 786 CALL wrk_dealloc( jpi,jpj, zacs, zaos )787 ! 788 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') 789 788 ! 790 789 END SUBROUTINE sbc_cpl_init … … 836 835 !! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 837 836 !!---------------------------------------------------------------------- 838 INTEGER, INTENT(in) :: kt! ocean model time step index839 INTEGER, INTENT(in) :: k_fsbc! frequency of sbc (-> ice model) computation840 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) 841 840 842 841 !! … … 852 851 !!---------------------------------------------------------------------- 853 852 ! 854 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv')855 ! 856 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 ) 857 856 ! 858 857 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1103 1102 IF( srcv(jpr_fice )%laction ) fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 1104 1103 ! 1105 1106 ENDIF 1107 ! 1108 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 1109 ! 1110 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') 1111 1109 ! 1112 1110 END SUBROUTINE sbc_cpl_rcv … … 1149 1147 REAL(wp), INTENT(out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) 1150 1148 !! 1151 INTEGER :: ji, jj 1152 INTEGER :: itx 1149 INTEGER :: ji, jj ! dummy loop indices 1150 INTEGER :: itx ! index of taux over ice 1153 1151 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty 1154 1152 !!---------------------------------------------------------------------- 1155 1153 ! 1156 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_tau')1157 ! 1158 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 ) 1159 1157 1160 1158 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 … … 1164 1162 ! do something only if we just received the stress from atmosphere 1165 1163 IF( nrcvinfo(itx) == OASIS_Rcv ) THEN 1166 1167 1164 ! ! ======================= ! 1168 1165 IF( srcv(jpr_itx1)%laction ) THEN ! ice stress received ! … … 1317 1314 ENDIF 1318 1315 ! 1319 CALL wrk_dealloc( jpi,jpj, ztx, zty )1320 ! 1321 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') 1322 1319 ! 1323 1320 END SUBROUTINE sbc_cpl_ice_tau … … 1364 1361 !! sprecip solid precipitation over the ocean 1365 1362 !!---------------------------------------------------------------------- 1366 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] 1367 1364 ! optional arguments, used only in 'mixed oce-ice' case 1368 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi 1369 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature[Celsius]1370 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature[Kelvin]1371 ! 1372 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 1373 1370 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk 1374 1371 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot … … 1377 1374 !!---------------------------------------------------------------------- 1378 1375 ! 1379 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx')1380 ! 1381 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )1382 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 ) 1383 1380 1384 1381 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1553 1550 CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1554 1551 #else 1555 1556 ! 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... 1557 1554 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1558 1555 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting … … 1570 1567 qns_ice(:,:,:) = zqns_ice(:,:,:) 1571 1568 ENDIF 1572 1569 ! 1573 1570 #endif 1574 1575 1571 ! ! ========================= ! 1576 1572 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr) … … 1681 1677 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1682 1678 1683 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )1684 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice )1685 ! 1686 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') 1687 1683 ! 1688 1684 END SUBROUTINE sbc_cpl_ice_flx … … 1707 1703 !!---------------------------------------------------------------------- 1708 1704 ! 1709 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_snd')1710 ! 1711 CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )1712 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 ) 1713 1709 1714 1710 isec = ( kt - nit000 ) * NINT(rdttra(1)) ! date of exchanges … … 2019 2015 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 2020 2016 2021 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )2022 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )2023 ! 2024 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') 2025 2021 ! 2026 2022 END SUBROUTINE sbc_cpl_snd -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
r5845 r6004 12 12 13 13 !!---------------------------------------------------------------------- 14 !! sbc_fwb : freshwater budget for global ocean configurations15 !! in free surface and forced mode16 !!----------------------------------------------------------------------17 USE oce ! ocean dynamics and tracers18 USE dom_oce ! ocean space and time domain19 USE sbc_oce ! surface ocean boundary condition20 USE phycst ! physical constants21 USE sbc rnf ! ocean runoffs22 USE sbc isf ! ice shelf melting contribution23 USE sbcssr ! SS damping terms24 USE in_out_manager 25 USE lib_mpp 26 USE wrk_nemo 27 USE timing 28 USE lbclnk 29 USE lib_fortran 14 !! sbc_fwb : freshwater budget for global ocean configurations (free surface & forced mode) 15 !!---------------------------------------------------------------------- 16 USE oce ! ocean dynamics and tracers 17 USE dom_oce ! ocean space and time domain 18 USE sbc_oce ! surface ocean boundary condition 19 USE phycst ! physical constants 20 USE sbcrnf ! ocean runoffs 21 USE sbcisf ! ice shelf melting contribution 22 USE sbcssr ! Sea-Surface damping terms 23 ! 24 USE in_out_manager ! I/O manager 25 USE lib_mpp ! distribued memory computing library 26 USE wrk_nemo ! work arrays 27 USE timing ! Timing 28 USE lbclnk ! ocean lateral boundary conditions 29 USE lib_fortran ! 30 30 31 31 IMPLICIT NONE -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r5845 r6004 25 25 USE thd_ice ! LIM-3: thermodynamical variables 26 26 USE dom_ice ! LIM-3: ice domain 27 27 ! 28 28 USE sbc_oce ! Surface boundary condition: ocean fields 29 29 USE sbc_ice ! Surface boundary condition: ice fields … … 32 32 USE sbccpl ! Surface boundary condition: coupled interface 33 33 USE albedo ! ocean & ice albedo 34 34 ! 35 35 USE phycst ! Define parameters for the routines 36 36 USE eosbn2 ! equation of state … … 47 47 USE limupdate2 ! update of global variables 48 48 USE limvar ! Ice variables switch 49 49 USE limctl ! 50 50 USE limmsh ! LIM mesh 51 51 USE limistate ! LIM initial state 52 52 USE limthd_sal ! LIM ice thermodynamics: salinity 53 53 ! 54 54 USE c1d ! 1D vertical configuration 55 USE in_out_manager ! I/O manager 56 USE iom ! I/O manager library 57 USE prtctl ! Print control 58 USE lib_fortran ! 55 59 USE lbclnk ! lateral boundary condition - MPP link 56 60 USE lib_mpp ! MPP library 57 61 USE wrk_nemo ! work arrays 58 62 USE timing ! Timing 59 USE iom ! I/O manager library60 USE in_out_manager ! I/O manager61 USE prtctl ! Print control62 USE lib_fortran !63 USE limctl64 63 65 64 #if defined key_bdy … … 81 80 !!---------------------------------------------------------------------- 82 81 CONTAINS 83 84 !!======================================================================85 82 86 83 SUBROUTINE sbc_ice_lim( kt, kblk ) … … 269 266 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ via Louvain la Neuve Ice Model (LIM-3) time stepping' 270 267 ! 271 268 ! ! Open the reference and configuration namelist files and namelist output file 272 269 CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 273 270 CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 274 271 IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 ) 275 272 ! 276 273 CALL ice_run ! set some ice run parameters 277 274 ! … … 347 344 REWIND( numnam_ice_ref ) ! Namelist namicerun in reference namelist : Parameters for ice 348 345 READ ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901) 349 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp )350 346 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp ) 347 ! 351 348 REWIND( numnam_ice_cfg ) ! Namelist namicerun in configuration namelist : Parameters for ice 352 349 READ ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 ) 353 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) 354 IF(lwm) WRITE ( numoni, namicerun ) 355 ! 350 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) 351 IF(lwm) WRITE( numoni, namicerun ) 356 352 ! 357 353 IF(lwp) THEN ! control print … … 404 400 REWIND( numnam_ice_ref ) ! Namelist namiceitd in reference namelist : Parameters for ice 405 401 READ ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 903) 406 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp )407 402 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp ) 403 ! 408 404 REWIND( numnam_ice_cfg ) ! Namelist namiceitd in configuration namelist : Parameters for ice 409 405 READ ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 904 ) 410 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp ) 411 IF(lwm) WRITE ( numoni, namiceitd ) 412 ! 406 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp ) 407 IF(lwm) WRITE( numoni, namiceitd ) 413 408 ! 414 409 IF(lwp) THEN ! control print … … 416 411 WRITE(numout,*) 'ice_itd : ice cat distribution' 417 412 WRITE(numout,*) ' ~~~~~~' 418 WRITE(numout,*) ' shape of ice categories distribution 419 WRITE(numout,*) ' mean ice thickness in the domain ( only active if nn_catbnd=2)rn_himean = ', rn_himean413 WRITE(numout,*) ' shape of ice categories distribution nn_catbnd = ', nn_catbnd 414 WRITE(numout,*) ' mean ice thickness in the domain (used if nn_catbnd=2) rn_himean = ', rn_himean 420 415 ENDIF 421 416 ! 422 417 !---------------------------------- 423 418 !- Thickness categories boundaries … … 426 421 IF(lwp) WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution ' 427 422 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 428 423 ! 429 424 hi_max(:) = 0._wp 430 431 SELECT CASE ( nn_catbnd ) 432 !---------------------- 433 CASE (1) ! tanh function (CICE) 434 !---------------------- 425 ! 426 SELECT CASE ( nn_catbnd ) ! type of ice categories distribution 427 ! 428 CASE (1) !== tanh function (CICE) ==! 435 429 zc1 = 3._wp / REAL( jpl, wp ) 436 430 zc2 = 10._wp * zc1 437 431 zc3 = 3._wp 438 439 432 DO jl = 1, jpl 440 433 zx1 = REAL( jl-1, wp ) / REAL( jpl, wp ) 441 434 hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) ) 442 435 END DO 443 444 !---------------------- 445 CASE (2) ! h^(-alpha) function 446 !---------------------- 447 zalpha = 0.05 ! exponent of the transform function 448 449 zhmax = 3.*rn_himean 450 436 ! 437 CASE (2) !== h^(-alpha) function ==! 438 zalpha = 0.05_wp 439 zhmax = 3._wp * rn_himean 451 440 DO jl = 1, jpl 452 441 znum = jpl * ( zhmax+1 )**zalpha 453 zden = ( jpl - jl ) * ( zhmax+1 )**zalpha + jl442 zden = REAL( jpl-jl , wp ) * ( zhmax + 1._wp )**zalpha + REAL( jl , wp ) 454 443 hi_max(jl) = ( znum / zden )**(1./zalpha) - 1 455 444 END DO 456 445 ! 457 446 END SELECT 458 459 DO jl = 1, jpl 447 ! 448 DO jl = 1, jpl ! mean thickness by category 460 449 hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp 461 450 END DO 462 463 ! Set hi_max(jpl) to a big value to ensure that all ice is thinner than hi_max(jpl) 464 hi_max(jpl) = 99._wp 465 451 ! 452 hi_max(jpl) = 99._wp ! set to a big value to ensure that all ice is thinner than hi_max(jpl) 453 ! 466 454 IF(lwp) WRITE(numout,*) ' Thickness category boundaries ' 467 455 IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl) … … 470 458 471 459 472 SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 460 SUBROUTINE ice_lim_flx( ptn_ice , palb_ice, pqns_ice , & 461 & pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 473 462 !!--------------------------------------------------------------------- 474 463 !! *** ROUTINE ice_lim_flx *** … … 482 471 !!--------------------------------------------------------------------- 483 472 INTEGER , INTENT(in ) :: k_limflx ! =-1 do nothing; =0 average ; 484 473 ! ! =1 average and redistribute ; =2 redistribute 485 474 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptn_ice ! ice surface temperature 486 475 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb_ice ! ice albedo … … 502 491 REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories 503 492 !!---------------------------------------------------------------------- 504 493 ! 505 494 IF( nn_timing == 1 ) CALL timing_start('ice_lim_flx') 506 !507 495 ! 508 496 SELECT CASE( k_limflx ) !== averaged on all ice categories ==! … … 528 516 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 529 517 END SELECT 530 518 ! 531 519 SELECT CASE( k_limflx ) !== redistribution on all ice categories ==! 532 520 CASE( 1 , 2 ) … … 547 535 ! 548 536 END SUBROUTINE ice_lim_flx 537 549 538 550 539 SUBROUTINE sbc_lim_bef … … 563 552 u_ice_b(:,:) = u_ice(:,:) 564 553 v_ice_b(:,:) = v_ice(:,:) 565 554 ! 566 555 END SUBROUTINE sbc_lim_bef 556 567 557 568 558 SUBROUTINE sbc_lim_diag0 … … 579 569 sfx_bom(:,:) = 0._wp ; sfx_sum(:,:) = 0._wp 580 570 sfx_res(:,:) = 0._wp 581 571 ! 582 572 wfx_snw(:,:) = 0._wp ; wfx_ice(:,:) = 0._wp 583 573 wfx_sni(:,:) = 0._wp ; wfx_opw(:,:) = 0._wp … … 586 576 wfx_res(:,:) = 0._wp ; wfx_sub(:,:) = 0._wp 587 577 wfx_spr(:,:) = 0._wp ; 588 578 ! 589 579 hfx_thd(:,:) = 0._wp ; 590 580 hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp … … 595 585 hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp 596 586 hfx_err_dif(:,:) = 0._wp ; 597 587 ! 598 588 afx_tot(:,:) = 0._wp ; 599 589 afx_dyn(:,:) = 0._wp ; afx_thd(:,:) = 0._wp 600 590 ! 601 591 diag_heat(:,:) = 0._wp ; diag_smvi(:,:) = 0._wp ; 602 592 diag_vice(:,:) = 0._wp ; diag_vsnw(:,:) = 0._wp ; 603 593 ! 604 594 END SUBROUTINE sbc_lim_diag0 605 595 … … 633 623 END FUNCTION fice_ice_ave 634 624 635 636 625 #else 637 626 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r5883 r6004 12 12 13 13 !!---------------------------------------------------------------------- 14 !! sbc_rnf : monthly runoffs read in a NetCDF file15 !! sbc_rnf_init : runoffs initialisation16 !! rnf_mouth : set river mouth mask14 !! sbc_rnf : monthly runoffs read in a NetCDF file 15 !! sbc_rnf_init : runoffs initialisation 16 !! rnf_mouth : set river mouth mask 17 17 !!---------------------------------------------------------------------- 18 USE dom_oce ! ocean space and time domain 19 USE phycst ! physical constants 20 USE sbc_oce ! surface boundary condition variables 21 USE sbcisf ! PM we could remove it I think 22 USE closea ! closed seas 23 USE fldread ! read input field at current time step 24 USE in_out_manager ! I/O manager 25 USE iom ! I/O module 26 USE lib_mpp ! MPP library 27 USE eosbn2 28 USE wrk_nemo ! Memory allocation 18 USE dom_oce ! ocean space and time domain 19 USE phycst ! physical constants 20 USE sbc_oce ! surface boundary condition variables 21 USE sbcisf ! PM we could remove it I think 22 USE closea ! closed seas 23 USE eosbn2 ! Equation Of State 24 ! 25 USE in_out_manager ! I/O manager 26 USE fldread ! read input field at current time step 27 USE iom ! I/O module 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! Memory allocation 29 30 30 31 IMPLICIT NONE 31 32 PRIVATE 32 33 33 PUBLIC sbc_rnf ! routinecalled in sbcmod module34 PUBLIC sbc_rnf_div ! routinecalled in divhor module35 PUBLIC sbc_rnf_alloc ! routinecalled in sbcmod module36 PUBLIC sbc_rnf_init ! routinecalled in sbcmod module34 PUBLIC sbc_rnf ! called in sbcmod module 35 PUBLIC sbc_rnf_div ! called in divhor module 36 PUBLIC sbc_rnf_alloc ! called in sbcmod module 37 PUBLIC sbc_rnf_init ! called in sbcmod module 37 38 38 ! 39 CHARACTER(len=100) :: cn_dir !: Root directory for location of rnf files39 ! !!* namsbc_rnf namelist * 40 CHARACTER(len=100) :: cn_dir !: Root directory for location of rnf files 40 41 LOGICAL :: ln_rnf_depth !: depth river runoffs attribute specified in a file 41 LOGICAL :: ln_rnf_depth_ini !: depth river runoffs computed at the initialisation42 REAL(wp) :: rn_rnf_max !: maximum value of the runoff climatologie ( ln_rnf_depth_ini = .true)43 REAL(wp) :: rn_dep_max !: depth over which runoffs is spread ( ln_rnf_depth_ini = .true)44 INTEGER :: nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0)45 LOGICAL :: ln_rnf_tem !: temperature river runoffs attribute specified in a file46 LOGICAL , PUBLIC :: ln_rnf_sal !: salinity river runoffs attribute specified in a file47 TYPE(FLD_N) , PUBLIC :: sn_rnf !: information about the runoff file to be read48 TYPE(FLD_N) :: sn_cnf !: information about the runoff mouth file to be read49 TYPE(FLD_N) :: sn_s_rnf !: information about the salinities of runoff file to be read50 TYPE(FLD_N) :: sn_t_rnf !: information about the temperatures of runoff file to be read51 TYPE(FLD_N) :: sn_dep_rnf !: information about the depth which river inflow affects52 LOGICAL , PUBLIC :: ln_rnf_mouth !: specific treatment in mouths vicinity53 REAL(wp) :: rn_hrnf !: runoffs, depth over which enhanced vertical mixing is used54 REAL(wp) , PUBLIC :: rn_avt_rnf !: runoffs, value of the additional vertical mixing coef. [m2/s]55 REAL(wp) :: rn_rfact !: multiplicative factor for runoff56 57 LOGICAL , PUBLIC :: l_rnfcpl = .false. !runoffs recieved from oasis58 59 INTEGER , PUBLIC :: nkrnf = 0 !: nb of levels over which Kz is increased at river mouths42 LOGICAL :: ln_rnf_depth_ini !: depth river runoffs computed at the initialisation 43 REAL(wp) :: rn_rnf_max !: maximum value of the runoff climatologie (ln_rnf_depth_ini =T) 44 REAL(wp) :: rn_dep_max !: depth over which runoffs is spread (ln_rnf_depth_ini =T) 45 INTEGER :: nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0) 46 LOGICAL :: ln_rnf_tem !: temperature river runoffs attribute specified in a file 47 LOGICAL , PUBLIC :: ln_rnf_sal !: salinity river runoffs attribute specified in a file 48 TYPE(FLD_N) , PUBLIC :: sn_rnf !: information about the runoff file to be read 49 TYPE(FLD_N) :: sn_cnf !: information about the runoff mouth file to be read 50 TYPE(FLD_N) :: sn_s_rnf !: information about the salinities of runoff file to be read 51 TYPE(FLD_N) :: sn_t_rnf !: information about the temperatures of runoff file to be read 52 TYPE(FLD_N) :: sn_dep_rnf !: information about the depth which river inflow affects 53 LOGICAL , PUBLIC :: ln_rnf_mouth !: specific treatment in mouths vicinity 54 REAL(wp) :: rn_hrnf !: runoffs, depth over which enhanced vertical mixing is used 55 REAL(wp) , PUBLIC :: rn_avt_rnf !: runoffs, value of the additional vertical mixing coef. [m2/s] 56 REAL(wp) :: rn_rfact !: multiplicative factor for runoff 57 58 LOGICAL , PUBLIC :: l_rnfcpl = .false. !: runoffs recieved from oasis 59 INTEGER , PUBLIC :: nkrnf = 0 !: nb of levels over which Kz is increased at river mouths 60 60 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnfmsk !: river mouth mask (hori.) 61 62 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rnfmsk_z !: river mouth mask (vert.) … … 211 212 ! 212 213 IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN !== runoff distributed over several levels ==! 213 IF( .NOT.ln_linssh ) THEN ! variable volume case 214 IF( ln_linssh ) THEN !* constant volume case : just apply the runoff input flow 215 DO jj = 1, jpj 216 DO ji = 1, jpi 217 DO jk = 1, nk_rnf(ji,jj) 218 phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj) 219 END DO 220 END DO 221 END DO 222 ELSE !* variable volume case 214 223 DO jj = 1, jpj ! update the depth over which runoffs are distributed 215 224 DO ji = 1, jpi … … 224 233 END DO 225 234 END DO 226 ELSE ! constant volume case : just apply the runoff input flow227 DO jj = 1, jpj228 DO ji = 1, jpi229 DO jk = 1, nk_rnf(ji,jj)230 phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)231 END DO232 END DO233 END DO234 235 ENDIF 235 236 ELSE !== runoff put only at the surface ==! 236 IF( .NOT.ln_linssh ) THEN ! variable volume case 237 h_rnf(:,:) = e3t_n(:,:,1) ! recalculate h_rnf to be depth of top box 238 ENDIF 237 h_rnf (:,:) = e3t_n (:,:,1) ! update h_rnf to be depth of top box 239 238 phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / e3t_n(:,:,1) 240 239 ENDIF -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r5866 r6004 6 6 !! History : 9.0 ! 2006-07 (G. Madec) Original code 7 7 !! 3.3 ! 2010-10 (C. Bricaud, G. Madec) add the Patm forcing for sea-ice 8 !!---------------------------------------------------------------------- 9 10 !!---------------------------------------------------------------------- 11 !! sbc_ssm : calculate sea surface mean currents, temperature, 12 !! and salinity over nn_fsbc time-step 13 !!---------------------------------------------------------------------- 14 USE oce ! ocean dynamics and tracers 15 USE dom_oce ! ocean space and time domain 16 USE sbc_oce ! surface boundary condition: ocean fields 17 USE sbcapr ! surface boundary condition: atmospheric pressure 18 USE eosbn2 ! equation of state and related derivatives 8 !! 3.7 ! 2015-11 (G. Madec) non linear free surface by default: e3t_m always computed 9 !!---------------------------------------------------------------------- 10 11 !!---------------------------------------------------------------------- 12 !! sbc_ssm : calculate sea surface mean currents, temperature, 13 !! and salinity over nn_fsbc time-step 14 !!---------------------------------------------------------------------- 15 USE oce ! ocean dynamics and tracers 16 USE dom_oce ! ocean space and time domain 17 USE sbc_oce ! surface boundary condition: ocean fields 18 USE sbcapr ! surface boundary condition: atmospheric pressure 19 USE eosbn2 ! equation of state and related derivatives 19 20 ! 20 USE in_out_manager 21 USE prtctl 22 USE iom 21 USE in_out_manager ! I/O manager 22 USE prtctl ! Print control 23 USE iom ! IOM library 23 24 24 25 IMPLICIT NONE 25 26 PRIVATE 26 27 27 PUBLIC sbc_ssm 28 PUBLIC sbc_ssm_init 29 30 LOGICAL, SAVE :: l_ssm_mean = .FALSE.! keep track of whether means have been read from restart file28 PUBLIC sbc_ssm ! routine called by step.F90 29 PUBLIC sbc_ssm_init ! routine called by sbcmod.F90 30 31 LOGICAL, SAVE :: l_ssm_mean = .FALSE. ! keep track of whether means have been read from restart file 31 32 32 33 !!---------------------------------------------------------------------- … … 56 57 REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts 57 58 !!--------------------------------------------------------------------- 58 59 ! 59 60 ! !* surface T-, U-, V- ocean level variables (T, S, depth, velocity) 60 61 DO jj = 1, jpj … … 78 79 ENDIF 79 80 ! 80 IF( .NOT.ln_linssh )e3t_m(:,:) = e3t_n(:,:,1)81 e3t_m(:,:) = e3t_n(:,:,1) 81 82 ! 82 83 frq_m(:,:) = fraqsr_1lev(:,:) … … 100 101 ENDIF 101 102 ! 102 IF( .NOT.ln_linssh )e3t_m(:,:) = zcoef * e3t_n(:,:,1)103 e3t_m(:,:) = zcoef * e3t_n(:,:,1) 103 104 ! 104 105 frq_m(:,:) = zcoef * fraqsr_1lev(:,:) … … 111 112 sss_m(:,:) = 0._wp 112 113 ssh_m(:,:) = 0._wp 113 IF( .NOT.ln_linssh )e3t_m(:,:) = 0._wp114 e3t_m(:,:) = 0._wp 114 115 frq_m(:,:) = 0._wp 115 116 ENDIF … … 128 129 ENDIF 129 130 ! 130 IF( .NOT.ln_linssh )e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1)131 ! 132 frq_m(:,:) = 131 e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1) 132 ! 133 frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:) 133 134 134 135 ! ! ---------------------------------------- ! … … 136 137 ! ! ---------------------------------------- ! 137 138 zcoef = 1. / REAL( nn_fsbc, wp ) 138 sst_m(:,:) = sst_m(:,:) * zcoef 139 sss_m(:,:) = sss_m(:,:) * zcoef 140 ssu_m(:,:) = ssu_m(:,:) * zcoef 141 ssv_m(:,:) = ssv_m(:,:) * zcoef 142 ssh_m(:,:) = ssh_m(:,:) * zcoef 143 IF( .NOT.ln_linssh ) e3t_m(:,:) = e3t_m(:,:) * zcoef! mean vertical scale factor [m]144 frq_m(:,:) = frq_m(:,:) * zcoef ! mean fraction of solar net radiation absorbed in the 1st T level [-]139 sst_m(:,:) = sst_m(:,:) * zcoef ! mean SST [Celcius] 140 sss_m(:,:) = sss_m(:,:) * zcoef ! mean SSS [psu] 141 ssu_m(:,:) = ssu_m(:,:) * zcoef ! mean suface current [m/s] 142 ssv_m(:,:) = ssv_m(:,:) * zcoef ! 143 ssh_m(:,:) = ssh_m(:,:) * zcoef ! mean SSH [m] 144 e3t_m(:,:) = e3t_m(:,:) * zcoef ! mean vertical scale factor [m] 145 frq_m(:,:) = frq_m(:,:) * zcoef ! mean fraction of solar net radiation absorbed in the 1st T level [-] 145 146 ! 146 147 ENDIF … … 159 160 CALL iom_rstput( kt, nitrst, numrow, 'sss_m' , sss_m ) 160 161 CALL iom_rstput( kt, nitrst, numrow, 'ssh_m' , ssh_m ) 161 IF( .NOT.ln_linssh )CALL iom_rstput( kt, nitrst, numrow, 'e3t_m' , e3t_m )162 CALL iom_rstput( kt, nitrst, numrow, 'e3t_m' , e3t_m ) 162 163 CALL iom_rstput( kt, nitrst, numrow, 'frq_m' , frq_m ) 163 164 ! … … 172 173 CALL iom_put( 'sss_m', sss_m ) 173 174 CALL iom_put( 'ssh_m', ssh_m ) 174 IF( .NOT.ln_linssh )CALL iom_put( 'e3t_m', e3t_m )175 CALL iom_put( 'e3t_m', e3t_m ) 175 176 CALL iom_put( 'frq_m', frq_m ) 176 177 ENDIF 177 178 ! 178 179 END SUBROUTINE sbc_ssm 180 179 181 180 182 SUBROUTINE sbc_ssm_init … … 186 188 !! ** Action : - read parameters 187 189 !!---------------------------------------------------------------------- 188 REAL(wp) :: zcoef, zf_sbc 190 REAL(wp) :: zcoef, zf_sbc ! local scalar 189 191 !!---------------------------------------------------------------------- 190 192 ! 191 193 IF( nn_fsbc == 1 ) THEN 192 194 ! … … 203 205 IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN 204 206 l_ssm_mean = .TRUE. 205 CALL iom_get( numror , 'nn_fsbc', zf_sbc ) ! sbc frequency of previous run206 CALL iom_get( numror, jpdom_autoglo, 'ssu_m' , ssu_m ) ! sea surface mean velocity (T-point)207 CALL iom_get( numror, jpdom_autoglo, 'ssv_m' , ssv_m ) ! " " velocity (V-point)208 CALL iom_get( numror, jpdom_autoglo, 'sst_m' , sst_m ) ! " " temperature (T-point)209 CALL iom_get( numror, jpdom_autoglo, 'sss_m' , sss_m ) ! " " salinity (T-point)210 CALL iom_get( numror, jpdom_autoglo, 'ssh_m' , ssh_m ) ! " " height (T-point)211 IF( .NOT.ln_linssh ) CALL iom_get( numror, jpdom_autoglo, 'e3t_m', e3t_m)207 CALL iom_get( numror , 'nn_fsbc', zf_sbc ) ! sbc frequency of previous run 208 CALL iom_get( numror, jpdom_autoglo, 'ssu_m' , ssu_m ) ! sea surface mean velocity (U-point) 209 CALL iom_get( numror, jpdom_autoglo, 'ssv_m' , ssv_m ) ! " " velocity (V-point) 210 CALL iom_get( numror, jpdom_autoglo, 'sst_m' , sst_m ) ! " " temperature (T-point) 211 CALL iom_get( numror, jpdom_autoglo, 'sss_m' , sss_m ) ! " " salinity (T-point) 212 CALL iom_get( numror, jpdom_autoglo, 'ssh_m' , ssh_m ) ! " " height (T-point) 213 CALL iom_get( numror, jpdom_autoglo, 'e3t_m' , e3t_m ) ! 1st level thickness (T-point) 212 214 ! fraction of solar net radiation absorbed in 1st T level 213 215 IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN … … 226 228 sss_m(:,:) = zcoef * sss_m(:,:) 227 229 ssh_m(:,:) = zcoef * ssh_m(:,:) 228 IF( .NOT.ln_linssh )e3t_m(:,:) = zcoef * e3t_m(:,:)230 e3t_m(:,:) = zcoef * e3t_m(:,:) 229 231 frq_m(:,:) = zcoef * frq_m(:,:) 230 232 ELSE … … 242 244 ELSE ; sst_m(:,:) = tsn(:,:,1,jp_tem) 243 245 ENDIF 244 sss_m(:,:) = tsn (:,:,1,jp_sal)245 ssh_m(:,:) = sshn (:,:)246 IF( .NOT.ln_linssh )e3t_m(:,:) = e3t_n(:,:,1)246 sss_m(:,:) = tsn (:,:,1,jp_sal) 247 ssh_m(:,:) = sshn (:,:) 248 e3t_m(:,:) = e3t_n(:,:,1) 247 249 frq_m(:,:) = 1._wp 248 250 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
r5845 r6004 19 19 ! 20 20 USE fldread ! read input fields 21 USE in_out_manager ! I/O manager 21 22 USE iom ! I/O manager 22 USE in_out_manager ! I/O manager23 23 USE lib_mpp ! distribued memory computing library 24 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90
r5215 r6004 6 6 !! History : 9.0 ! 2007 (O. Le Galloudec) Original code 7 7 !!---------------------------------------------------------------------- 8 USE oce ! ocean dynamics and tracers variables 9 USE dom_oce ! ocean space and time domain 10 USE phycst 11 USE daymod 12 USE dynspg_oce 13 USE tideini 8 USE oce ! ocean dynamics and tracers variables 9 USE dom_oce ! ocean space and time domain 10 USE phycst ! physical constant 11 USE daymod ! calandar 12 USE tideini ! 14 13 ! 15 USE i om16 USE i n_out_manager ! I/O units17 USE ioipsl 18 USE lbclnk 14 USE in_out_manager ! I/O units 15 USE iom ! xIOs server 16 USE ioipsl ! NetCDF IPSL library 17 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 19 18 20 19 IMPLICIT NONE -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90
r5215 r6004 6 6 !! History : 1.0 ! 2007 (O. Le Galloudec) Original code 7 7 !!---------------------------------------------------------------------- 8 USE oce ! ocean dynamics and tracers variables 9 USE dom_oce ! ocean space and time domain 10 USE phycst 11 USE daymod 12 USE dynspg_oce 13 USE tide_mod 8 USE oce ! ocean dynamics and tracers variables 9 USE dom_oce ! ocean space and time domain 10 USE phycst ! physical constant 11 USE daymod ! calandar 12 USE tide_mod ! 14 13 ! 15 USE i om16 USE i n_out_manager ! I/O units17 USE ioipsl 18 USE lbclnk 14 USE in_out_manager ! I/O units 15 USE iom ! xIOs server 16 USE ioipsl ! NetCDF IPSL library 17 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 19 18 20 19 IMPLICIT NONE … … 28 27 LOGICAL , PUBLIC :: ln_tide_pot !: 29 28 LOGICAL , PUBLIC :: ln_tide_ramp !: 30 INTEGER , PUBLIC :: nb_harmo 31 INTEGER , PUBLIC :: kt_tide 32 REAL(wp), PUBLIC :: rdttideramp 29 INTEGER , PUBLIC :: nb_harmo !: 30 INTEGER , PUBLIC :: kt_tide !: 31 REAL(wp), PUBLIC :: rdttideramp !: 33 32 34 33 INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntide !: … … 41 40 CONTAINS 42 41 43 SUBROUTINE tide_init ( kt ) 44 !!---------------------------------------------------------------------- 45 !! *** ROUTINE tide_init *** 46 !!---------------------------------------------------------------------- 47 !! * Local declarations 48 INTEGER :: ji, jk 49 INTEGER, INTENT( in ) :: kt ! ocean time-step 50 CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: clname 51 INTEGER :: ios ! Local integer output status for namelist read 52 ! 53 NAMELIST/nam_tide/ln_tide_pot, ln_tide_ramp, rdttideramp, clname 54 !!---------------------------------------------------------------------- 55 56 IF ( kt == nit000 ) THEN 57 ! 58 IF(lwp) THEN 59 WRITE(numout,*) 60 WRITE(numout,*) 'tide_init : Initialization of the tidal components' 61 WRITE(numout,*) '~~~~~~~~~ ' 62 ENDIF 63 ! 64 CALL tide_init_Wave 65 ! 66 ! Read Namelist nam_tide 67 REWIND( numnam_ref ) ! Namelist nam_tide in reference namelist : Tides 68 READ ( numnam_ref, nam_tide, IOSTAT = ios, ERR = 901) 69 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_tide in reference namelist', lwp ) 70 71 REWIND( numnam_cfg ) ! Namelist nam_tide in configuration namelist : Tides 72 READ ( numnam_cfg, nam_tide, IOSTAT = ios, ERR = 902 ) 73 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_tide in configuration namelist', lwp ) 74 IF(lwm) WRITE ( numond, nam_tide ) 75 ! 76 nb_harmo=0 77 DO jk = 1, jpmax_harmo 78 DO ji = 1,jpmax_harmo 79 IF( TRIM(clname(jk)) == Wave(ji)%cname_tide ) nb_harmo = nb_harmo + 1 80 END DO 81 END DO 82 ! 83 ! Ensure that tidal components have been set in namelist_cfg 84 IF( nb_harmo .EQ. 0 ) CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' ) 85 ! 86 IF(lwp) THEN 87 WRITE(numout,*) ' Namelist nam_tide' 88 WRITE(numout,*) ' Apply astronomical potential : ln_tide_pot =', ln_tide_pot 89 WRITE(numout,*) ' nb_harmo = ', nb_harmo 90 WRITE(numout,*) ' ln_tide_ramp = ', ln_tide_ramp 91 WRITE(numout,*) ' rdttideramp = ', rdttideramp 92 ENDIF 93 IF( ln_tide_ramp.AND.((nitend-nit000+1)*rdt/rday < rdttideramp) ) & 94 & CALL ctl_stop('rdttideramp must be lower than run duration') 95 IF( ln_tide_ramp.AND.(rdttideramp<0.) ) & 96 & CALL ctl_stop('rdttideramp must be positive') 97 ! 98 IF( .NOT. lk_dynspg_ts ) CALL ctl_warn( 'sbc_tide : use of time splitting is recommended' ) 99 ! 100 ALLOCATE( ntide(nb_harmo) ) 101 DO jk = 1, nb_harmo 102 DO ji = 1, jpmax_harmo 103 IF( TRIM(clname(jk)) .eq. Wave(ji)%cname_tide ) THEN 104 ntide(jk) = ji 105 EXIT 106 END IF 107 END DO 108 END DO 109 ! 110 ALLOCATE( omega_tide(nb_harmo), v0tide (nb_harmo), & 111 & utide (nb_harmo), ftide (nb_harmo) ) 112 kt_tide = kt 113 ! 42 SUBROUTINE tide_init 43 !!---------------------------------------------------------------------- 44 !! *** ROUTINE tide_init *** 45 !!---------------------------------------------------------------------- 46 INTEGER :: ji, jk 47 CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: clname 48 INTEGER :: ios ! Local integer output status for namelist read 49 ! 50 NAMELIST/nam_tide/ln_tide_pot, ln_tide_ramp, rdttideramp, clname 51 !!---------------------------------------------------------------------- 52 ! 53 IF(lwp) THEN 54 WRITE(numout,*) 55 WRITE(numout,*) 'tide_init : Initialization of the tidal components' 56 WRITE(numout,*) '~~~~~~~~~ ' 114 57 ENDIF 58 ! 59 CALL tide_init_Wave 60 ! 61 ! Read Namelist nam_tide 62 REWIND( numnam_ref ) ! Namelist nam_tide in reference namelist : Tides 63 READ ( numnam_ref, nam_tide, IOSTAT = ios, ERR = 901) 64 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_tide in reference namelist', lwp ) 65 ! 66 REWIND( numnam_cfg ) ! Namelist nam_tide in configuration namelist : Tides 67 READ ( numnam_cfg, nam_tide, IOSTAT = ios, ERR = 902 ) 68 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_tide in configuration namelist', lwp ) 69 IF(lwm) WRITE ( numond, nam_tide ) 70 ! 71 nb_harmo=0 72 DO jk = 1, jpmax_harmo 73 DO ji = 1,jpmax_harmo 74 IF( TRIM(clname(jk)) == Wave(ji)%cname_tide ) nb_harmo = nb_harmo + 1 75 END DO 76 END DO 77 ! 78 ! Ensure that tidal components have been set in namelist_cfg 79 IF( nb_harmo == 0 ) CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' ) 80 ! 81 IF(lwp) THEN 82 WRITE(numout,*) ' Namelist nam_tide' 83 WRITE(numout,*) ' Apply astronomical potential : ln_tide_pot =', ln_tide_pot 84 WRITE(numout,*) ' nb_harmo = ', nb_harmo 85 WRITE(numout,*) ' ln_tide_ramp = ', ln_tide_ramp 86 WRITE(numout,*) ' rdttideramp = ', rdttideramp 87 ENDIF 88 IF( ln_tide_ramp.AND.((nitend-nit000+1)*rdt/rday < rdttideramp) ) & 89 & CALL ctl_stop('rdttideramp must be lower than run duration') 90 IF( ln_tide_ramp.AND.(rdttideramp<0.) ) & 91 & CALL ctl_stop('rdttideramp must be positive') 92 ! 93 ALLOCATE( ntide(nb_harmo) ) 94 DO jk = 1, nb_harmo 95 DO ji = 1, jpmax_harmo 96 IF( TRIM(clname(jk)) == Wave(ji)%cname_tide ) THEN 97 ntide(jk) = ji 98 EXIT 99 ENDIF 100 END DO 101 END DO 102 ! 103 ALLOCATE( omega_tide(nb_harmo), v0tide (nb_harmo), & 104 & utide (nb_harmo), ftide (nb_harmo) ) 105 kt_tide = nit000 115 106 ! 116 107 END SUBROUTINE tide_init -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90
r5215 r6004 4 4 !! Initialization of tidal forcing 5 5 !!====================================================================== 6 !! History : 9.0 ! 07 (O. Le Galloudec) Original code6 !! History : 9.0 ! 2007 (O. Le Galloudec) Original code 7 7 !!---------------------------------------------------------------------- 8 8 #if defined key_tide … … 10 10 !! 'key_tide' : tidal potential 11 11 !!---------------------------------------------------------------------- 12 !! upd_tide 12 !! upd_tide : update tidal potential 13 13 !!---------------------------------------------------------------------- 14 USE oce 15 USE dom_oce 16 USE in_out_manager 17 USE phycst 18 USE sbctide 19 USE tideini , ONLY:ln_tide_ramp, rdttideramp14 USE oce ! ocean dynamics and tracers variables 15 USE dom_oce ! ocean space and time domain 16 USE in_out_manager ! I/O units 17 USE phycst ! physical constant 18 USE sbctide ! tide potential variable 19 USE tideini , ONLY: ln_tide_ramp, rdttideramp 20 20 21 21 IMPLICIT NONE … … 45 45 INTEGER, INTENT(in), OPTIONAL :: kbaro ! number of sub-time-step (lk_dynspg_ts=T only) 46 46 INTEGER, INTENT(in), OPTIONAL :: koffset ! time offset in number 47 47 ! ! of sub-time-steps (lk_dynspg_ts=T only) 48 48 ! 49 49 INTEGER :: joffset ! local integer … … 93 93 WRITE(*,*) 'upd_tide: You should not have seen this print! error?', kt 94 94 END SUBROUTINE upd_tide 95 96 95 #endif 97 96
Note: See TracChangeset
for help on using the changeset viewer.