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.
flx_oasis_ice.h90 in trunk/NEMO/OPA_SRC/SBC – NEMO

source: trunk/NEMO/OPA_SRC/SBC/flx_oasis_ice.h90 @ 532

Last change on this file since 532 was 532, checked in by opalod, 18 years ago

nemo_v1_update_76 : CT : add OASIS[3-4] interfaces to build coupled configurations
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 12.2 KB
Line 
1   !!----------------------------------------------------------------------
2   !!                     ***  flx_oasis_ice.h90  ***
3   !!----------------------------------------------------------------------
4   !!   flx          : define the thermohaline fluxes for the ocean in
5   !!                  coupled ocean/atmosphere case with sea-ice
6   !!----------------------------------------------------------------------
7
8    REAL(wp) :: zcatm1  (1:jpi,1:jpj)  ! cloud fraction
9
10    REAL(wp) :: qsr_oce_recv   (1:jpi,1:jpj)
11    REAL(wp) :: qsr_ice_recv   (1:jpi,1:jpj)
12    REAL(wp) :: qnsr_oce_recv   (1:jpi,1:jpj)
13    REAL(wp) :: qnsr_ice_recv   (1:jpi,1:jpj)
14    REAL(wp) :: dqns_ice_recv   (1:jpi,1:jpj)
15    REAL(wp) :: tprecip_recv   (1:jpi,1:jpj)   
16    REAL(wp) :: sprecip_recv   (1:jpi,1:jpj)
17    REAL(wp) :: fr1_i0_recv   (1:jpi,1:jpj)   
18    REAL(wp) :: fr2_i0_recv   (1:jpi,1:jpj)   
19    REAL(wp) :: rrunoff_recv   (1:jpi,1:jpj)
20    REAL(wp) :: calving_recv   (1:jpi,1:jpj)
21#if defined key_cpl_ocevel
22    REAL(wp) :: un_weighted (1:jpi,1:jpj)
23    REAL(wp) :: vn_weighted (1:jpi,1:jpj)
24    REAL(wp) :: un_send (1:jpi,1:jpj)
25    REAL(wp) :: vn_send (1:jpi,1:jpj)
26#endif
27    REAL(wp) :: zrunriv (1:jpi,1:jpj)  ! river discharge into ocean
28    REAL(wp) :: zruncot (1:jpi,1:jpj)  ! continental discharge into ocean
29
30    REAL(wp) :: zpew    (1:jpi,1:jpj)  ! P-E over water
31    REAL(wp) :: zpei    (1:jpi,1:jpj)  ! P-E over ice
32    REAL(wp) :: zpsol   (1:jpi,1:jpj)  ! surface downward snow fall
33    REAL(wp) :: zevice  (1:jpi,1:jpj)  ! surface upward snow flux where sea ice
34
35   !! * Modules used     C A U T I O N  already defined in flxmod.F90
36   !!
37   !! * Module variables
38   LOGICAL :: lfirstf=.TRUE.
39   !!----------------------------------------------------------------------
40   !!   OPA 9.0 , LOCEAN-IPSL (2006)
41   !! $Header$
42   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
43   !!----------------------------------------------------------------------
44
45CONTAINS
46
47  SUBROUTINE flx( kt )
48    !!---------------------------------------------------------------------
49    !!                    ***  ROUTINE flx  ***
50    !!                   
51    !! ** Purpose :   exchange the thermohaline fields (heat and freshwater)
52    !!                with the atmosphere at each ocean time step.
53    !!
54    !! ** Method  :   Receive and send fluxes from/to a coupled atmospheric model
55    !!
56    !! References : The OASIS User Guide, Version 3.0
57    !!
58    !! History :
59    !!   9.0  !  04-11  (R. Redler)  Original code
60    !!        !  05-05  (W. Park, N. Keenlyside) Separation of recv and pass variables (ref.icestp.F90)
61    !!        !  05-09  (W. Park, N. Keenlyside) Implementation of ocean velocity
62    !!        !  06-06  (E. Maisonnave, W. Park) Oasis mask adaptation
63    !!----------------------------------------------------------------------
64    !! * Modules used
65     USE in_out_manager, only: numout ! I/O manager
66     
67    !! * Arguments
68    INTEGER, INTENT( in  ) ::   kt    ! ocean time step
69
70    !! * Local declarations
71    INTEGER :: ji, jj
72
73#if defined key_cpl_ocevel
74    INTEGER :: ikchoix=-1
75#endif
76
77    INTEGER  :: var_id
78    INTEGER  :: info, date, n
79
80    REAL(wp) :: zfacflx
81    REAL(wp) :: zfacwat
82    !
83    !!---------------------------------------------------------------------
84    !
85    ! Initialization
86    ! --------------
87    !
88    ! caution, I presume that you have good UNIT system from coupler to OPA
89    ! that is :
90    ! watt/m2 for znsolc and zqsrc
91    ! kg/m2/s for evaporation, precipitation and runoff
92    zfacflx = 1.e0
93    zfacwat = 1.e3  ! convert [m/s] to [kg/m**2/s]
94    !
95    date = ( kt - nit000 ) * rdttra(1)
96    !
97    ! 1. Send coupling fields
98    !------------------------
99    !
100    var_id = send_id(1)
101    CALL cpl_prism_send ( var_id, date, tn(:,:,1)+rt0, info )     
102    var_id = send_id(2)
103    CALL cpl_prism_send ( var_id, date, 1.0-frld, info )     
104
105#if defined key_cpl_albedo
106    DO jj = 1, jpj
107       DO ji = 1, jpi
108         if (((tn_ice(ji,jj).lt.50).or.(tn_ice(ji,jj).gt.400)) .and. frld(ji,jj).lt.1.) then
109         WRITE(numout,*) ' tn_ice, ERROR ',ji,jj, ' = ', tn_ice(ji,jj), &
110          ' qnsr_ice_recv=', qnsr_ice_recv(ji,jj), ' dqns_ice_recv=', dqns_ice_recv(ji,jj)
111          endif
112       ENDDO
113    ENDDO
114    var_id = send_id(3)
115    CALL cpl_prism_send ( var_id, date, tn_ice, info )     
116
117    var_id = send_id(4)
118    CALL cpl_prism_send ( var_id, date, alb_ice, info )
119#else
120    var_id = send_id(3)
121    CALL cpl_prism_send ( var_id, date, hicif, info )     
122
123    var_id = send_id(4)
124    CALL cpl_prism_send ( var_id, date, hsnif, info )     
125#endif
126
127#if defined key_cpl_ocevel
128    un_weighted = un(:,:,1) * frld + u_ice * ( 1. - frld )
129    vn_weighted = vn(:,:,1) * frld + v_ice * ( 1. - frld )
130    CALL repere ( un_weighted, vn_weighted, un_send, vn_send, ikchoix )
131
132    var_id = send_id(5)
133    CALL cpl_prism_send ( var_id, date, un_send, info )
134
135    var_id = send_id(6)
136    CALL cpl_prism_send ( var_id, date, vn_send, info )
137#endif
138    !
139    ! 2. Receive and build flux fields
140    !---------------------------------
141    !
142    ! I.) Precipitation/Evaporation
143    ! -----------------------------
144    !
145    ! ... a) P-E over water
146    !
147    var_id = recv_id(9)
148    CALL cpl_prism_recv ( var_id, date, zpew,  info )
149    !
150    ! ... b) P-E over ice
151    !
152    var_id = recv_id(10)
153    CALL cpl_prism_recv ( var_id, date, zpei, info )
154    !
155    ! ... c) Snow fall over water and ice
156    !
157    var_id = recv_id(11)
158    CALL cpl_prism_recv ( var_id, date, zpsol, info  )
159    !
160    ! ... d) Evaporation over ice (sublimination)
161    !
162    var_id = recv_id(12)
163    CALL cpl_prism_recv ( var_id, date, zevice, info )
164    !
165    ! calculate water flux (PE over water and ice)  (positive upward)
166    DO jj = 1, jpj
167       DO ji = 1, jpi
168          tprecip_recv(ji,jj) = ( zpew(ji,jj) + zpei(ji,jj) ) * tmask(ji,jj,1) * zfacwat
169       ENDDO
170    ENDDO
171    IF (ln_ctl) THEN
172      WRITE(numout,*) ' flx:tprecip_recv    - Minimum value is ', MINVAL(tprecip_recv)
173      WRITE(numout,*) ' flx:tprecip_recv    - Maximum value is ', MAXVAL(tprecip_recv)
174      WRITE(numout,*) ' flx:tprecip_recv    -     Sum value is ', SUM(tprecip_recv)
175    ENDIF
176
177    IF ( SUM(zpew*e1t*e2t) /= SUM(zpew*e1t*e2t*tmask(:,:,1)) ) THEN
178       WRITE(numout,*) ' flx: Forcing values outside Orca mask'
179       WRITE(numout,*) ' flx: Losses in water conservation'
180       WRITE(numout,*) ' flx:   Masked ', SUM(zpew*e1t*e2t*tmask(:,:,1))
181       WRITE(numout,*) ' flx: Unmasked ', SUM(zpew*e1t*e2t)
182       WRITE(numout,*) ' flx: Simulation STOP'
183       CALL FLUSH(numout)
184       STOP
185    END IF
186
187    !
188    ! calculate solid precipitation  (positive upward)
189    DO jj = 1, jpj
190       DO ji = 1, jpi
191          sprecip_recv(ji,jj) = ( zpsol(ji,jj) + zevice(ji,jj) ) * tmask(ji,jj,1) * zfacwat
192       ENDDO
193    ENDDO
194    !
195    !
196    ! II.) Solar fluxes
197    ! ------------------
198    !
199    ! ... a) surface net downward shortwave flux
200    !
201    var_id = recv_id(13)
202    CALL cpl_prism_recv ( var_id, date, qsr_oce_recv, info )
203
204    DO jj = 1, jpj
205       DO ji = 1, jpi
206          qsr_oce_recv(ji,jj) =  qsr_oce_recv(ji,jj) * tmask(ji,jj,1) * zfacflx
207       ENDDO
208    ENDDO
209    !
210    ! ... b) surface downward non-solar heat flux in air
211    !
212    var_id = recv_id(14)
213    CALL cpl_prism_recv ( var_id, date, qnsr_oce_recv, info)
214
215    DO jj = 1, jpj
216       DO ji = 1, jpi
217          qnsr_oce_recv(ji,jj) = qnsr_oce_recv(ji,jj) * tmask(ji,jj,1) * zfacflx
218       ENDDO
219    ENDDO
220    !
221    ! ... c) solar heat flux on sea ice
222    !
223    var_id = recv_id(15)
224    CALL cpl_prism_recv ( var_id, date, qsr_ice_recv, info )
225
226    DO jj = 1, jpj
227       DO ji = 1, jpi
228          qsr_ice_recv(ji,jj) = qsr_ice_recv(ji,jj) * tmask(ji,jj,1) * zfacflx
229       ENDDO
230    ENDDO
231    !
232    ! ... d) non-solar heat flux on sea ice
233    !
234    var_id = recv_id(16)
235    CALL cpl_prism_recv ( var_id, date, qnsr_ice_recv, info)
236
237    DO jj = 1, jpj
238       DO ji = 1, jpi
239          qnsr_ice_recv(ji,jj) = qnsr_ice_recv(ji,jj) * tmask(ji,jj,1) * zfacflx
240       ENDDO
241    ENDDO
242    !
243    ! ... e) non solar heat flux derivative over ice
244    !
245    var_id = recv_id(17)
246    CALL cpl_prism_recv ( var_id, date, dqns_ice_recv, info)
247
248    DO jj = 1, jpj
249       DO ji = 1, jpi
250          dqns_ice_recv(ji,jj) =  dqns_ice_recv(ji,jj) * tmask(ji,jj,1) * zfacflx
251       ENDDO
252    ENDDO
253    !
254    ! Since cloud cover catm not transmitted from atmosphere, init =0.
255    !
256    catm(:, :) = 0.
257    DO jj = 1, jpj
258       DO ji = 1, jpi
259          zcatm1(ji,jj) = 1.0    - catm  (ji,jj)  !  fractional cloud cover
260       END DO
261    END DO
262
263    !  fraction of net shortwave radiation which is not absorbed in the
264    !  thin surface layer and penetrates inside the ice cover
265    !  ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 )
266    !------------------------------------------------------------------
267    DO jj = 1, jpj
268       DO ji = 1, jpi
269          fr1_i0_recv(ji,jj) = 0.18  * zcatm1(ji,jj) + 0.35 * catm(ji,jj)
270          fr2_i0_recv(ji,jj) = 0.82  * zcatm1(ji,jj) + 0.65 * catm(ji,jj)
271       END DO
272    END DO
273    !
274#if defined key_cpl_discharge
275    ! III.) Runoff
276    ! -----------
277    !
278    ! ... a) ice discharge into ocean
279    !
280    var_id = recv_id(18)
281    CALL cpl_prism_recv ( var_id, date, calving_recv, info )
282
283    DO jj = 1, jpj
284       DO ji = 1, jpi
285          calving_recv(ji,jj) = calving_recv(ji,jj) * tmask(ji,jj,1) * zfacwat
286       ENDDO
287    ENDDO
288    !
289    ! ... b) river discharge into ocean
290    !
291    var_id = recv_id(19)
292    CALL cpl_prism_recv ( var_id, date, zrunriv, info )
293    !
294    ! ... c) continental discharge into ocean
295    !
296    var_id = recv_id(20)
297    CALL cpl_prism_recv ( var_id, date, zruncot, info)
298
299    DO jj = 1, jpj
300       DO ji = 1, jpi
301          rrunoff_recv(ji,jj) = ( zrunriv(ji,jj) + zruncot (ji,jj) ) * tmask(ji,jj,1) * zfacwat
302       ENDDO
303    ENDDO
304    !
305#else
306    calving_recv = 0.
307    rrunoff_recv = 0.
308#endif
309
310    ! Oasis mask shift and update lateral boundary conditions (E. Maisonnave)
311    ! not tested when mpp is used, W. Park
312!WSPTEST
313    qsr_oce_recv(jpi-1,:) = qsr_oce_recv(1,:)
314    qsr_ice_recv(jpi-1,:) = qsr_ice_recv(1,:)
315    qnsr_oce_recv(jpi-1,:) = qnsr_oce_recv(1,:)
316    qnsr_ice_recv(jpi-1,:) = qnsr_ice_recv(1,:)
317    dqns_ice_recv(jpi-1,:) = dqns_ice_recv(1,:)
318    tprecip_recv(jpi-1,:) = tprecip_recv(1,:)
319    sprecip_recv(jpi-1,:) = sprecip_recv(1,:)
320    fr1_i0_recv(jpi-1,:) = fr1_i0_recv(1,:)
321    fr2_i0_recv(jpi-1,:) = fr2_i0_recv(1,:)
322    rrunoff_recv(jpi-1,:) = rrunoff_recv(1,:)
323    calving_recv(jpi-1,:) = calving_recv(1,:)
324
325    qsr_oce = qsr_oce_recv
326    qsr_ice = qsr_ice_recv
327    qnsr_oce = qnsr_oce_recv
328    qnsr_ice = qnsr_ice_recv
329    dqns_ice = dqns_ice_recv
330    tprecip = tprecip_recv
331    sprecip = sprecip_recv
332    fr1_i0 = fr1_i0_recv 
333    fr2_i0 = fr2_i0_recv 
334!WSP    rrunoff = rrunoff_recv
335!WSP    calving = calving_recv
336    rrunoff = 0.  !WSP runoff and calving included in tprecip
337    calving = 0.  !WSP
338 
339    IF(ln_ctl) THEN
340    write(numout,*) 'flx:qsr_oce     - Minimum value is ', minval(qsr_oce)
341    write(numout,*) 'flx:qsr_oce     - Maximum value is ', maxval(qsr_oce)
342    write(numout,*) 'flx:qsr_oce     -     Sum value is ', SUM(qsr_oce)
343
344    write(numout,*) 'flx:tprecip     - Minimum value is ', minval(tprecip)
345    write(numout,*) 'flx:tprecip     - Maximum value is ', maxval(tprecip)
346    write(numout,*) 'flx:tprecip     -     Sum value is ', SUM(tprecip)
347    ENDIF
348
349    CALL lbc_lnk( qsr_oce , 'T', 1. )
350    CALL lbc_lnk( qsr_ice , 'T', 1. )
351    CALL lbc_lnk( qnsr_oce, 'T', 1. )
352    CALL lbc_lnk( qnsr_ice, 'T', 1. )
353    CALL lbc_lnk( tprecip , 'T', 1. )
354    CALL lbc_lnk( sprecip , 'T', 1. )
355    CALL lbc_lnk( rrunoff , 'T', 1. )
356    CALL lbc_lnk( dqns_ice, 'T', 1. )
357    CALL lbc_lnk( calving , 'T', 1. )
358    CALL lbc_lnk( fr1_i0  , 'T', 1. )
359    CALL lbc_lnk( fr2_i0  , 'T', 1. )
360
361    IF(ln_ctl) THEN
362    write(numout,*) 'flx(af lbc_lnk):qsr_oce     - Minimum value is ', minval(qsr_oce)
363    write(numout,*) 'flx(af lbc_lnk):qsr_oce     - Maximum value is ', maxval(qsr_oce)
364    write(numout,*) 'flx(af lbc_lnk):qsr_oce     -     Sum value is ', SUM(qsr_oce)
365
366    write(numout,*) 'flx(af lbc_lnk):tprecip     - Minimum value is ', minval(tprecip)
367    write(numout,*) 'flx(af lbc_lnk):tprecip     - Maximum value is ', maxval(tprecip)
368    write(numout,*) 'flx(af lbc_lnk):tprecip     -     Sum value is ', SUM(tprecip)
369    ENDIF
370
371END SUBROUTINE flx
Note: See TracBrowser for help on using the repository browser.