[3] | 1 | !!---------------------------------------------------------------------- |
---|
| 2 | !! *** ocesbc_forced_noice.h90 *** |
---|
| 3 | !!---------------------------------------------------------------------- |
---|
| 4 | |
---|
| 5 | SUBROUTINE oce_sbc(kt) |
---|
| 6 | !!--------------------------------------------------------------------- |
---|
| 7 | !! *** ROUTINE oce_sbc *** |
---|
| 8 | !! |
---|
| 9 | !! ** Purpose : Ocean surface boundary conditions |
---|
| 10 | !! in forced mode using flux formulation or bulk formulation |
---|
| 11 | !! |
---|
| 12 | !! |
---|
| 13 | !! History : |
---|
| 14 | !! 1.0 ! 99-11 (M. Imbard) Original code |
---|
| 15 | !! ! 01-03 (D. Ludicone, E. Durand, G. Madec) free surf. |
---|
| 16 | !! 2.0 ! 02-09 (G. Madec, C. Ethe) F90: Free form and module |
---|
| 17 | !!---------------------------------------------------------------------- |
---|
| 18 | !! * Modules used |
---|
| 19 | USE daymod |
---|
| 20 | #if ! defined key_dtasst |
---|
| 21 | USE dtasst, ONLY : rclice |
---|
| 22 | #endif |
---|
| 23 | |
---|
| 24 | #if defined key_flx_bulk_monthly || defined key_flx_bulk_daily |
---|
| 25 | USE blk_oce |
---|
| 26 | #endif |
---|
| 27 | |
---|
| 28 | #if defined key_flx_forced_daily |
---|
| 29 | USE flx_oce |
---|
| 30 | #endif |
---|
| 31 | !! * arguments |
---|
| 32 | INTEGER, INTENT( in ) :: kt ! ocean time step |
---|
| 33 | |
---|
| 34 | !! * local declarations |
---|
| 35 | INTEGER :: ji, jj ! dummy loop arguments |
---|
| 36 | INTEGER :: i15, ifreq ! |
---|
| 37 | REAL(wp) :: zxy |
---|
| 38 | REAL(wp) :: zsice, zqri, zqrp, ztdta, zqrj |
---|
| 39 | REAL(wp) :: zq, zqi, zhemis, ztrp |
---|
| 40 | REAL(wp), DIMENSION(jpi,jpj) :: zeri, zerps, ziclim |
---|
| 41 | REAL(wp), DIMENSION(jpi,jpj) :: zqt, zqsr, zemp |
---|
| 42 | |
---|
| 43 | !!---------------------------------------------------------------------- |
---|
| 44 | !! OPA 8.5, LODYC-IPSL (2002) |
---|
| 45 | !!---------------------------------------------------------------------- |
---|
| 46 | |
---|
| 47 | ! 1. initialization to zero at kt = nit000 |
---|
| 48 | ! --------------------------------------- |
---|
| 49 | |
---|
| 50 | IF( kt == nit000 ) THEN |
---|
| 51 | qsr (:,:) = 0.e0 |
---|
| 52 | freeze (:,:) = 0.e0 |
---|
| 53 | qt (:,:) = 0.e0 |
---|
| 54 | q (:,:) = 0.e0 |
---|
| 55 | qrp (:,:) = 0.e0 |
---|
| 56 | emp (:,:) = 0.e0 |
---|
| 57 | emps (:,:) = 0.e0 |
---|
| 58 | erp (:,:) = 0.e0 |
---|
| 59 | #if defined key_dynspg_fsc |
---|
| 60 | dmp (:,:) = 0.e0 |
---|
| 61 | #endif |
---|
| 62 | ENDIF |
---|
| 63 | |
---|
| 64 | #if defined key_flx_bulk_monthly || defined key_flx_bulk_daily |
---|
| 65 | ifreq = nfbulk |
---|
| 66 | zqt (:,:) = qsr_oce(:,:) + qnsr_oce(:,:) |
---|
| 67 | zqsr(:,:) = qsr_oce(:,:) |
---|
| 68 | zemp(:,:) = evap(:,:) - tprecip(:,:) |
---|
| 69 | #endif |
---|
| 70 | |
---|
| 71 | #if defined key_flx_forced_daily |
---|
| 72 | ifreq = 1 |
---|
| 73 | zqt (:,:) = p_qt (:,:) |
---|
| 74 | zqsr(:,:) = p_qsr(:,:) |
---|
| 75 | zemp(:,:) = p_emp(:,:) |
---|
| 76 | #endif |
---|
| 77 | |
---|
| 78 | IF( MOD( kt-1, ifreq) == 0 ) THEN |
---|
| 79 | ! Computation of internal and evaporation damping terms |
---|
| 80 | CALL oce_sbc_dmp |
---|
| 81 | |
---|
| 82 | ztrp = -40. ! restoring terme for temperature (w/m2/k) |
---|
| 83 | zsice = - 0.04 / 0.8 ! ratio of isohaline compressibility over isotherme compressibility |
---|
| 84 | ! ( d rho / dt ) / ( d rho / ds ) ( s = 34, t = -1.8 ) |
---|
| 85 | ! Flux computation |
---|
| 86 | DO jj = 1, jpj |
---|
| 87 | DO ji = 1, jpi |
---|
| 88 | ! climatological ice |
---|
| 89 | #if defined key_dtasst |
---|
| 90 | ziclim(ji,jj) = FLOAT( NINT( rclice(ji,jj,1) ) ) |
---|
| 91 | #else |
---|
| 92 | ! tested only with key key_dtasst (A. Lazar 07/2001) |
---|
| 93 | ! this loop in CASE of interpolation of monthly rclice |
---|
| 94 | i15 = INT( 2.* FLOAT(nday) / (FLOAT( nobis(nmonth) ) + 0.5) ) |
---|
| 95 | zxy = FLOAT(nday) / FLOAT(nobis(nmonth)) + 0.5 - i15 |
---|
| 96 | ziclim(ji,jj) = FLOAT( NINT( (1-zxy) * rclice(ji,jj,1) + zxy * rclice(ji,jj,2) ) ) |
---|
| 97 | #endif |
---|
| 98 | |
---|
| 99 | ! avoid surfreezing point |
---|
| 100 | tn(ji,jj,1) = MAX( tn(ji,jj,1), fzptn(ji,jj) ) |
---|
| 101 | |
---|
| 102 | ! hemisphere indicator (=1 north, =-1 south) |
---|
| 103 | zhemis = FLOAT( isign(1, mjg(jj) - (jpjdta/2+1) ) ) |
---|
| 104 | |
---|
| 105 | ! restoring temperature (ztdta >= to local freezing temperature) |
---|
| 106 | #if defined key_dtasst |
---|
| 107 | ztdta = MAX( sst(ji,jj), fzptn(ji,jj) ) |
---|
| 108 | #else |
---|
| 109 | ztdta = MAX( t_dta(ji,jj,1), fzptn(ji,jj) ) |
---|
| 110 | #endif |
---|
| 111 | |
---|
| 112 | ! a) net downward radiative flux qsr() |
---|
| 113 | qsr(ji,jj) = zqsr(ji,jj) * tmask(ji,jj,1) |
---|
| 114 | |
---|
| 115 | ! b) heat flux damping term qrp() |
---|
| 116 | ! - gamma*(t-tlevitus) if no climatological ice (ziclim=0) |
---|
| 117 | ! - gamma*(t-(tgel-1.)) if climatological ice and no opa ice (ziclim=1 zicopa=0) |
---|
| 118 | ! - gamma*min(0,t-tgel) if climatological and opa ice (ziclim=1 zicopa=1) |
---|
| 119 | |
---|
| 120 | zqrp = ztrp * ( tb(ji,jj,1) - ztdta ) |
---|
| 121 | zqri = ztrp * ( tb(ji,jj,1) - ( fzptn(ji,jj) - 1.) ) |
---|
| 122 | zqrj = ztrp * MIN( 0., tb(ji,jj,1) - fzptn(ji,jj) ) |
---|
| 123 | qrp(ji,jj) = ( (1. - ziclim(ji,jj)) * zqrp & |
---|
| 124 | + ziclim(ji,jj) * ( ( 1 - freeze(ji,jj)) * zqri & |
---|
| 125 | + freeze(ji,jj) * zqrj ) ) * tmask(ji,jj,1) |
---|
| 126 | |
---|
| 127 | ! c) net downward heat flux q() = q0 + qrp() |
---|
| 128 | ! for q0 |
---|
| 129 | ! - ECMWF fluxes if no climatological ice (ziclim=0) |
---|
| 130 | ! - qrp if climatological ice and no opa ice (ziclim=1 zicopa=0) |
---|
| 131 | ! - -2 watt/m2 (arctic) or -4 watt/m2 (antarctic) if climatological and opa ice |
---|
| 132 | ! (ziclim=1 zicopa=1) |
---|
| 133 | zq = zqt(ji,jj) |
---|
| 134 | zqi = -3. + zhemis |
---|
| 135 | qt (ji,jj) = ( (1.-ziclim(ji,jj)) * zq & |
---|
| 136 | +ziclim(ji,jj) * freeze(ji,jj) * zqi ) & |
---|
| 137 | * tmask(ji,jj,1) & |
---|
| 138 | + qrp(ji,jj) |
---|
| 139 | q (ji,jj) = qt (ji,jj) |
---|
| 140 | |
---|
| 141 | END DO |
---|
| 142 | END DO |
---|
| 143 | |
---|
| 144 | #if defined key_dynspg_fsc |
---|
| 145 | ! Free-surface |
---|
| 146 | |
---|
| 147 | ! Water flux for zero buoyancy flux if no opa ice and ice clim |
---|
| 148 | zeri(:,:) = -zsice * qrp(:,:) * ro0cpr * rauw / 34.0 |
---|
| 149 | zerps(:,:) = ziclim(:,:) * ( (1-freeze(:,:)) * zeri(:,:) ) |
---|
| 150 | |
---|
| 151 | ! Contribution to sea level: |
---|
| 152 | ! net upward water flux emp() = e-p + runoff() + erp() + dmp + empold |
---|
| 153 | emp (:,:) = zemp(:,:) & ! e-p data |
---|
| 154 | + runoff(:,:) & ! runoff data |
---|
| 155 | + erp(:,:) & ! restoring term to SSS data |
---|
| 156 | + dmp(:,:) & ! freshwater flux associated with internal damping |
---|
| 157 | + empold ! domain averaged annual mean correction |
---|
| 158 | |
---|
| 159 | ! Contribution to salinity: |
---|
| 160 | ! net upward water flux emps() = e-p + runoff() + erp() + zerps + empold |
---|
| 161 | emps(:,:) = zemp(:,:) & |
---|
| 162 | + runoff(:,:) & |
---|
| 163 | + erp(:,:) & |
---|
| 164 | + zerps(:,:) & |
---|
| 165 | + empold |
---|
| 166 | #else |
---|
| 167 | ! Rigid-lid (emp=emps=E-P-R+Erp) |
---|
| 168 | ! freshwater flux |
---|
| 169 | zeri(:,:) = -zsice * qrp(:,:) * ro0cpr * rauw / 34.0 |
---|
| 170 | zerps(:,:) = ziclim(:,:) * ( (1-freeze(:,:)) * zeri(:,:) ) |
---|
| 171 | emps (:,:) = zemp(:,:) & |
---|
| 172 | + runoff(:,:) & |
---|
| 173 | + erp(:,:) & |
---|
| 174 | + zerps(:,:) |
---|
| 175 | emp (:,:) = emps(:,:) |
---|
| 176 | #endif |
---|
| 177 | |
---|
| 178 | |
---|
| 179 | ! Boundary condition on emp for free surface option |
---|
| 180 | ! ------------------------------------------------- |
---|
| 181 | CALL lbc_lnk( emp, 'T', 1. ) |
---|
| 182 | |
---|
| 183 | ENDIF |
---|
| 184 | |
---|
| 185 | END SUBROUTINE oce_sbc |
---|