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 @ 247

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

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

Download in other formats:

Original Format