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

Context Navigation

source: trunk/NEMO/OPA_SRC/SBC/flx_coupled_ice.h90 @ 161

Last change on this file since 161 was 161, checked in by opalod, 19 years ago
CT + CL : UPDATE104 : Add sublimation trough zevice(:,:) array over sea-ice in the solid precipitation sent to the sea-ice model
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 12.8 KB

Line
1	!!----------------------------------------------------------------------
2	!! * flx_coupled_ice.h90 *
3	!!----------------------------------------------------------------------
4	!! flx : define the thermohaline fluxes for the ocean in
5	!! coupled ocean/atmosphere case with sea-ice
6	!!----------------------------------------------------------------------
7	!! * Modules used C A U T I O N already defined in flxmod.F90
8
9	!! * Module variables
10	LOGICAL :: lfirstf=.TRUE.
11	INTEGER :: nhoridcf, nidcf
12	INTEGER, DIMENSION(jpi*jpj) :: ndexcf
13	!!----------------------------------------------------------------------
14	!! OPA 9.0 , LODYC-IPSL (2003)
15	!!----------------------------------------------------------------------
16
17	CONTAINS
18
19	SUBROUTINE flx( kt )
20	!!---------------------------------------------------------------------
21	!! * ROUTINE flx *
22	!!
23	!! ** Purpose : provide the thermohaline fluxes (heat and freshwater)
24	!! to the ocean at each time step.
25	!!
26	!! ** Method : Read fluxes from a coupled Atmospheric model
27	!!
28	!! References : The OASIS User Guide, Version 2.0, CERFACS/TR 95/46
29	!!
30	!! History :
31	!! ! (O. Marti) Original code
32	!! 8.5 ! 02-09 (G. Madec) F90: Free form and module
33	!!----------------------------------------------------------------------
34	!! * Modules used
35	USE ioipsl ! NetCDF IPSL library
36	USE ice_oce
37	USE cpl_oce ! coupled ocean-atmosphere variables
38	USE flx_oce ! sea-ice/ocean forcings variables
39
40	!! * arguments
41	INTEGER, INTENT( in ) :: kt ! ocean time step
42
43	!! * Local declarations
44	INTEGER :: ji, jj, jf
45	INTEGER :: itm1,isize,iflag
46	! INTEGER :: icpliter
47	INTEGER :: info, inuread, index
48	REAL(wp) :: zfacflx,zfacwat
49	REAL(wp) :: znsolc (jpiglo,jpjglo),zqsrc (jpiglo,jpjglo)
50	REAL(wp) :: zrunoff(jpiglo,jpjglo),zec (jpiglo,jpjglo)
51	REAL(wp) :: zqsrice (jpiglo,jpjglo),zqsrwat (jpiglo,jpjglo)
52	REAL(wp) :: znsolice(jpiglo,jpjglo),znsolwat(jpiglo,jpjglo)
53	REAL(wp) :: znsicedt(jpiglo,jpjglo),zevice (jpiglo,jpjglo)
54	REAL(wp) :: zevwat (jpiglo,jpjglo),zpliq (jpiglo,jpjglo)
55	REAL(wp) :: zpsol (jpiglo,jpjglo),zruncot (jpiglo,jpjglo)
56	REAL(wp) :: zrunriv (jpiglo,jpjglo),zcalving(jpiglo,jpjglo)
57	REAL(wp) :: zevap (jpiglo,jpjglo)
58	REAL(wp) :: zcatm1 (jpiglo,jpjglo) ! cloud fraction
59	CHARACTER (len=80) :: clcplfnam
60	REAL(wp) :: zjulian
61
62	! Addition for SIPC CASE
63	CHARACTER (len=3) :: clmodinf ! Header or not
64	! CHARACTER (len=3) :: cljobnam_r ! Experiment name in the field brick, if any
65	! INTEGER :: infos(3) ! infos in the field brick, if any
66	!!---------------------------------------------------------------------
67
68
69	! Initialization
70	! --------------
71
72	isize = jpiglo * jpjglo
73	itm1 = ( kt - nit000 + 1 ) - 1
74
75	! initialisation for output
76
77	IF( lfirstf ) THEN
78	lfirstf = .FALSE.
79	ndexcf(:) = 0
80	clcplfnam = "cpl_oce_flx"
81
82	! Compute julian date from starting date of the run
83	CALL ymds2ju( nyear, nmonth, nday, 0.e0, zjulian )
84	CALL histbeg(clcplfnam, jpiglo,glamt,jpjglo,gphit,1,jpiglo,1 &
85	,jpjglo,0,zjulian,rdt,nhoridcf,nidcf)
86	! no vertical axis
87	DO jf = 1, nflxc2o
88	CALL histdef(nidcf, cpl_readflx(jf),cpl_readflx(jf), &
89	"-",jpi, jpj, nhoridcf, 1, 1, 1, -99, 32, "inst", &
90	rdt,rdt)
91	END DO
92	CALL histend(nidcf)
93	ENDIF
94
95	! caution, I presume that you have good UNIT system from coupler to OPA
96	! that is :
97	! watt/m2 for znsolc and zqsrc
98	! kg/m2/s for evaporation, precipitation and runoff
99	zfacflx = 1.e0
100	! water should be in kg/m2/day
101	zfacwat = 1.e0 ! 86400.0e0
102
103	! Test if we couple at the current timestep
104	! -----------------------------------------
105
106	IF( MOD(kt,nexco) == 1 ) THEN
107
108	! Test what kind of message passing we are using
109
110	IF(lwp) WRITE(numout,*)
111	IF(lwp) WRITE(numout,*)'FLX: Read fields from CPL, itm1=',itm1
112	IF(lwp) WRITE(numout,*)
113	CALL FLUSH (numout)
114
115	IF( cchan == 'PIPE' ) THEN
116	! pipe mode
117
118	! UNIT number for fields
119
120	inuread = 99
121
122	! exchanges from to atmosphere=CPL to ocean
123
124	DO jf = 1, nflxc2o
125	! CALL PIPE_Model_Recv(cpl_readflx(jf), icpliter, numout)
126	OPEN (inuread, FILE=cpl_f_readflx(jf), FORM='UNFORMATTED')
127	IF(jf == 1) CALL locread(cpl_readflx(jf),znsolc ,isize,inuread,iflag,numout)
128	IF(jf == 2) CALL locread(cpl_readflx(jf),zqsrc ,isize,inuread,iflag,numout)
129	IF(jf == 3) CALL locread(cpl_readflx(jf),zec ,isize,inuread,iflag,numout)
130	IF(jf == 4) CALL locread(cpl_readflx(jf),zrunoff,isize,inuread,iflag,numout)
131	CLOSE (inuread)
132	END DO
133
134	ELSE IF( cchan == 'SIPC' ) THEN
135	! SIPC mode
136
137	! Define IF a header must be encapsulated within the field brick :
138	clmodinf = 'NOT' ! as $MODINFO in namcouple
139
140	! reading of input field non solar flux SONSHLDO
141	index = 1
142	! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, znsolc )
143
144	! reading of input field solar heat flux SOSHFLDO
145	index = 2
146	! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zqsrc )
147
148	! reading of input field water flux SOWAFLDO
149	index = 3
150	! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zec )
151
152	! reading of input field runoff SORUNOFF
153	index = 4
154	! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zrunoff)
155
156	ELSE IF( cchan == 'CLIM' ) THEN
157	! CLIM mode
158	IF(lwp) WRITE (numout,*) 'Reading flux from coupler '
159	! exchanges from atmosphere=CPL to ocean
160	DO jf = 1, nflxc2o
161	IF(jf == 1) CALL CLIM_Import (cpl_readflx(jf),itm1,zqsrice ,info)
162	IF(jf == 2) CALL CLIM_Import (cpl_readflx(jf),itm1,zqsrwat ,info)
163	IF(jf == 3) CALL CLIM_Import (cpl_readflx(jf),itm1,znsolice,info)
164	IF(jf == 4) CALL CLIM_Import (cpl_readflx(jf),itm1,znsolwat,info)
165	IF(jf == 5) CALL CLIM_Import (cpl_readflx(jf),itm1,znsicedt,info)
166	IF(jf == 6) CALL CLIM_Import (cpl_readflx(jf),itm1,zevice ,info)
167	IF(jf == 7) CALL CLIM_Import (cpl_readflx(jf),itm1,zevwat ,info)
168	IF(jf == 8) CALL CLIM_Import (cpl_readflx(jf),itm1,zpliq ,info)
169	IF(jf == 9) CALL CLIM_Import (cpl_readflx(jf),itm1,zpsol ,info)
170	IF(jf == 10) CALL CLIM_Import (cpl_readflx(jf),itm1,zruncot ,info)
171	IF(jf == 11) CALL CLIM_Import (cpl_readflx(jf),itm1,zrunriv ,info)
172	IF(jf == 12) CALL CLIM_Import (cpl_readflx(jf),itm1,zcalving,info)
173	IF( info /= CLIM_Ok ) THEN
174	IF(lwp) WRITE(numout,*)'Pb in reading ', cpl_readflx(jf), jf
175	IF(lwp) WRITE(numout,*)'Couplage itm1 is = ',itm1
176	IF(lwp) WRITE(numout,*)'CLIM error code is = ', info
177	IF(lwp) WRITE(numout,*)'STOP in Flx'
178	CALL abort('flx.coupled.h')
179	ENDIF
180	END DO
181	ENDIF
182
183	! netcdf outputs
184
185	DO jf = 1, nflxc2o
186	IF(jf == 1) CALL histwrite(nidcf,cpl_readflx(jf), kt, zqsrice ,jpi*jpj,ndexcf)
187	IF(jf == 2) CALL histwrite(nidcf,cpl_readflx(jf), kt, zqsrwat ,jpi*jpj,ndexcf)
188	IF(jf == 3) CALL histwrite(nidcf,cpl_readflx(jf), kt, znsolice,jpi*jpj,ndexcf)
189	IF(jf == 4) CALL histwrite(nidcf,cpl_readflx(jf), kt, znsolwat,jpi*jpj,ndexcf)
190	IF(jf == 5) CALL histwrite(nidcf,cpl_readflx(jf), kt, znsicedt,jpi*jpj,ndexcf)
191	IF(jf == 6) CALL histwrite(nidcf,cpl_readflx(jf), kt, zevice ,jpi*jpj,ndexcf)
192	IF(jf == 7) CALL histwrite(nidcf,cpl_readflx(jf), kt, zevwat ,jpi*jpj,ndexcf)
193	IF(jf == 8) CALL histwrite(nidcf,cpl_readflx(jf), kt, zpliq ,jpi*jpj,ndexcf)
194	IF(jf == 9) CALL histwrite(nidcf,cpl_readflx(jf), kt, zpsol ,jpi*jpj,ndexcf)
195	IF(jf == 10) CALL histwrite(nidcf,cpl_readflx(jf), kt, zruncot ,jpi*jpj,ndexcf)
196	IF(jf == 11) CALL histwrite(nidcf,cpl_readflx(jf), kt, zrunriv ,jpi*jpj,ndexcf)
197	IF(jf == 12) CALL histwrite(nidcf,cpl_readflx(jf), kt, zcalving,jpi*jpj,ndexcf)
198	END DO
199	CALL histsync(nidcf)
200	IF( nitend-kt < nexco ) CALL histclo(nidcf)
201
202	! Compute average evaporation
203	DO jj = 1, nlcj
204	DO ji = 1, nlci
205	zevap( mig(ji), mjg(jj)) = zevwat( mig(ji), mjg(jj)) * ( 1.e0 - freeze(ji,jj) ) &
206	& + zevice( mig(ji), mjg(jj)) * freeze(ji,jj)
207	END DO
208	END DO
209
210	! Set sublimation to zero in ice-free boxes
211	DO jj = 1, nlcj
212	DO ji = 1, nlci
213	IF( freeze(ji,jj) <= 0.0e0 ) zevice(mig(ji),mjg(jj)) = 0.0e0
214	END DO
215	END DO
216
217	! Since cloud cover catm not transmitted from atmosphere, init =0.
218
219	catm(:, :) =0.
220	DO jj = 1, jpj
221	DO ji = 1, jpi
222	zcatm1(ji,jj) = 1.0 - catm (ji,jj) ! fractional cloud cover
223	END DO
224	END DO
225
226	! fraction of net shortwave radiation which is not absorbed in the
227	! thin surface layer and penetrates inside the ice cover
228	! ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 )
229	!------------------------------------------------------------------
230	DO jj = 1, nlcj
231	DO ji = 1, nlci
232	fr1_i0(ji,jj) = 0.18 * zcatm1(ji,jj) + 0.35 * catm(ji,jj)
233	fr2_i0(ji,jj) = 0.82 * zcatm1(ji,jj) + 0.65 * catm(ji,jj)
234	END DO
235	END DO
236
237	! copy in the subdomain
238
239	DO jj = 1, nlcj
240	DO ji = 1, nlci
241	! 1: Net short wave heat flux on free ocean (positive downward)
242	qsr_oce(ji,jj) = zqsrwat ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacflx
243	! 2: Net short wave het flux on sea ice (positive downward)
244	qsr_ice(ji,jj) = zqsrice ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacflx
245	! 3: Net longwave heat flux on free ocean (positive downward)
246	qnsr_oce(ji,jj)= znsolwat ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacflx
247	! 4: Net longwave heat flux on sea ice
248	qnsr_ice(ji,jj)= znsolice ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacflx
249	! 5: Water flux (liquid precipitation - evaporation) (positive upward)
250	tprecip(ji,jj) = ( zpliq ( mig(ji), mjg(jj)) &
251	& + zpsol ( mig(ji), mjg(jj)) &
252	& + zevap ( mig(ji), mjg(jj)) ) * tmask(ji,jj,1) * zfacwat
253	! 6: Solid precipitation (positive upward)
254	sprecip(ji,jj) = ( zpsol( mig(ji), mjg(jj) ) + zevice( mig(ji),mjg(jj) ) ) &
255	& * tmask(ji,jj,1) * zfacwat
256	! 7: runoff (positive upward)
257	rrunoff(ji,jj) = ( zruncot ( mig(ji), mjg(jj)) &
258	& + zrunriv ( mig(ji), mjg(jj)) ) * tmask(ji,jj,1) * zfacwat
259	! 8: Derivative of non solar heat flux on sea ice
260	dqns_ice(ji,jj) = znsicedt ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacflx
261	! 13: Iceberg calving (positive upward)
262	calving(ji,jj) = zcalving ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacwat
263	! 1st part of the fraction of sol. rad. which penetrate inside
264	! the ice cover
265	fr1_i0(ji,jj) = fr1_i0(mig(ji), mjg(jj)) * tmask(ji,jj,1)
266	! 2nd part of the fraction of sol. rad. which penetrate inside
267	! the ice cover
268	fr2_i0(ji,jj) = fr2_i0(mig(ji), mjg(jj)) * tmask(ji,jj,1)
269	END DO
270	END DO
271
272
273	CALL lbc_lnk( qsr_oce , 'T', 1. )
274	CALL lbc_lnk( qsr_ice , 'T', 1. )
275	CALL lbc_lnk( qnsr_oce, 'T', 1. )
276	CALL lbc_lnk( qnsr_ice, 'T', 1. )
277	CALL lbc_lnk( tprecip , 'T', 1. )
278	CALL lbc_lnk( sprecip , 'T', 1. )
279	CALL lbc_lnk( rrunoff , 'T', 1. )
280	CALL lbc_lnk( dqns_ice, 'T', 1. )
281	CALL lbc_lnk( calving , 'T', 1. )
282	CALL lbc_lnk( fr1_i0 , 'T', 1. )
283	CALL lbc_lnk( fr2_i0 , 'T', 1. )
284
285	ENDIF
286
287	END SUBROUTINE flx

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format