New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
ocesbc_forced_noice.h90 in trunk/NEMO/OPA_SRC/SBC – NEMO

source: trunk/NEMO/OPA_SRC/SBC/ocesbc_forced_noice.h90 @ 3

Last change on this file since 3 was 3, checked in by opalod, 20 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.1 KB
Line 
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
Note: See TracBrowser for help on using the repository browser.