1 | MODULE sedwri |
---|
2 | #if defined key_sed |
---|
3 | !!====================================================================== |
---|
4 | !! *** MODULE sedwri *** |
---|
5 | !! Sediment diagnostics : write sediment output files |
---|
6 | !!====================================================================== |
---|
7 | USE sed |
---|
8 | USE sedarr |
---|
9 | USE ioipsl |
---|
10 | USE dianam ! build name of file (routine) |
---|
11 | |
---|
12 | IMPLICIT NONE |
---|
13 | PRIVATE |
---|
14 | |
---|
15 | !! * Accessibility |
---|
16 | PUBLIC sed_wri |
---|
17 | |
---|
18 | INTEGER :: nised |
---|
19 | INTEGER :: nhorised |
---|
20 | INTEGER :: ndimt52 |
---|
21 | INTEGER :: ndimt51 |
---|
22 | INTEGER :: ndepsed |
---|
23 | REAL(wp) :: zjulian |
---|
24 | INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext52 |
---|
25 | INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext51 |
---|
26 | |
---|
27 | !! $Id$ |
---|
28 | CONTAINS |
---|
29 | |
---|
30 | !!---------------------------------------------------------------------- |
---|
31 | !! NetCDF output file |
---|
32 | !!---------------------------------------------------------------------- |
---|
33 | SUBROUTINE sed_wri( kt ) |
---|
34 | !!---------------------------------------------------------------------- |
---|
35 | !! *** ROUTINE sed_wri *** |
---|
36 | !! |
---|
37 | !! ** Purpose : output of sediment passive tracer |
---|
38 | !! |
---|
39 | !! History : |
---|
40 | !! ! 06-07 (C. Ethe) original |
---|
41 | !!---------------------------------------------------------------------- |
---|
42 | |
---|
43 | INTEGER, INTENT(in) :: kt |
---|
44 | |
---|
45 | CHARACTER(len = 60) :: clhstnam, clop |
---|
46 | INTEGER :: ji, jk, js, jw, jn |
---|
47 | REAL(wp) :: zsto,zout, zdt |
---|
48 | INTEGER :: iimi, iima, ijmi, ijma,ipk, it, itmod |
---|
49 | CHARACTER(len = 20) :: cltra , cltrau |
---|
50 | CHARACTER(len = 80) :: cltral |
---|
51 | REAL(wp) :: zrate |
---|
52 | REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdta, zflx |
---|
53 | |
---|
54 | !!------------------------------------------------------------------- |
---|
55 | |
---|
56 | |
---|
57 | ! Initialisation |
---|
58 | ! ----------------- |
---|
59 | IF( kt == nittrc000 ) ALLOCATE( ndext52(jpij*jpksed), ndext51(jpij) ) |
---|
60 | |
---|
61 | ! Define frequency of output and means |
---|
62 | zdt = dtsed |
---|
63 | IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!) |
---|
64 | ELSE ; clop = "x" ! no use of the mask value (require less cpu time) |
---|
65 | ENDIF |
---|
66 | #if defined key_diainstant |
---|
67 | zsto = nwrised * zdt |
---|
68 | clop = "inst("//TRIM(clop)//")" |
---|
69 | #else |
---|
70 | zsto = zdt |
---|
71 | clop = "ave("//TRIM(clop)//")" |
---|
72 | #endif |
---|
73 | zout = nwrised * zdt |
---|
74 | |
---|
75 | ! Define indices of the horizontal output zoom and vertical limit storage |
---|
76 | iimi = 1 ; iima = jpi |
---|
77 | ijmi = 1 ; ijma = jpj |
---|
78 | ipk = jpksed |
---|
79 | |
---|
80 | ! define time axis |
---|
81 | it = kt |
---|
82 | itmod = kt - nitsed000 + 1 |
---|
83 | |
---|
84 | |
---|
85 | ! 1. Initilisations |
---|
86 | ! ----------------------------------------------------------------- |
---|
87 | WRITE(numsed,*) ' ' |
---|
88 | WRITE(numsed,*) 'sed_wri kt = ', kt |
---|
89 | WRITE(numsed,*) ' ' |
---|
90 | |
---|
91 | ALLOCATE( zdta(jpoce,jpksed) ) ; ALLOCATE( zflx(jpoce,jpwatp1) ) |
---|
92 | |
---|
93 | |
---|
94 | ! 2. Back to 2D geometry |
---|
95 | ! ----------------------------------------------------------------- |
---|
96 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & |
---|
97 | & solcp(1:jpoce,1:jpksed,jsopal ) ) |
---|
98 | |
---|
99 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & |
---|
100 | & solcp(1:jpoce,1:jpksed,jsclay ) ) |
---|
101 | |
---|
102 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), & |
---|
103 | & solcp(1:jpoce,1:jpksed,jspoc ) ) |
---|
104 | |
---|
105 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,4) , iarroce(1:jpoce), & |
---|
106 | & solcp(1:jpoce,1:jpksed,jscal ) ) |
---|
107 | |
---|
108 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,5) , iarroce(1:jpoce), & |
---|
109 | & pwcp(1:jpoce,1:jpksed,jwsil ) ) |
---|
110 | |
---|
111 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,6) , iarroce(1:jpoce), & |
---|
112 | & pwcp(1:jpoce,1:jpksed,jwoxy ) ) |
---|
113 | |
---|
114 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,7) , iarroce(1:jpoce), & |
---|
115 | & pwcp(1:jpoce,1:jpksed,jwdic ) ) |
---|
116 | |
---|
117 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,8) , iarroce(1:jpoce), & |
---|
118 | & pwcp(1:jpoce,1:jpksed,jwno3 ) ) |
---|
119 | |
---|
120 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,9) , iarroce(1:jpoce), & |
---|
121 | & pwcp(1:jpoce,1:jpksed,jwpo4 ) ) |
---|
122 | |
---|
123 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,10) , iarroce(1:jpoce), & |
---|
124 | & pwcp(1:jpoce,1:jpksed,jwalk ) ) |
---|
125 | |
---|
126 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,11) , iarroce(1:jpoce), & |
---|
127 | & pwcp(1:jpoce,1:jpksed,jwc13 ) ) |
---|
128 | |
---|
129 | ! porosity |
---|
130 | zdta(:,:) = 0. |
---|
131 | DO jk = 1, jpksed |
---|
132 | DO ji = 1, jpoce |
---|
133 | zdta(ji,jk) = -LOG10( hipor(ji,jk) / densSW(ji) ) |
---|
134 | ENDDO |
---|
135 | ENDDO |
---|
136 | CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & |
---|
137 | & zdta(1:jpoce,1:jpksed) ) |
---|
138 | |
---|
139 | CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & |
---|
140 | & co3por(1:jpoce,1:jpksed) ) |
---|
141 | |
---|
142 | |
---|
143 | ! computation of delta 13C |
---|
144 | zdta(:,:) = 0. |
---|
145 | DO jk = 1, jpksed |
---|
146 | DO ji = 1, jpoce |
---|
147 | zdta(ji,jk) = ( ( pwcp(ji,jk,jwc13) / pwcp(ji,jk,jwdic) / pdb ) - 1. ) & |
---|
148 | & * 1000. |
---|
149 | ENDDO |
---|
150 | ENDDO |
---|
151 | CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), & |
---|
152 | & zdta(1:jpoce,1:jpksed) ) |
---|
153 | |
---|
154 | |
---|
155 | zflx(:,:) = 0. |
---|
156 | ! Calculation of fluxes mol/cm2/s |
---|
157 | DO jw = 1, jpwat |
---|
158 | DO ji = 1, jpoce |
---|
159 | zflx(ji,jw) = ( pwcp(ji,1,jw) - pwcp_dta(ji,jw) ) & |
---|
160 | & * 1.e-3 * dzkbot(ji) / dtsed |
---|
161 | ENDDO |
---|
162 | ENDDO |
---|
163 | ! Calculation of accumulation rate per dt |
---|
164 | DO js = 1, jpsol |
---|
165 | zrate = mol_wgt(js) / ( dens * por1(jpksed) ) / dtsed |
---|
166 | DO ji = 1, jpoce |
---|
167 | zflx(ji,jpwatp1) = zflx(ji,jpwatp1) + ( tosed(ji,js) - fromsed(ji,js) ) * zrate |
---|
168 | ENDDO |
---|
169 | ENDDO |
---|
170 | |
---|
171 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,1), iarroce(1:jpoce), zflx(1:jpoce,1) ) |
---|
172 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,2), iarroce(1:jpoce), zflx(1:jpoce,2) ) |
---|
173 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,3), iarroce(1:jpoce), zflx(1:jpoce,3) ) |
---|
174 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,4), iarroce(1:jpoce), zflx(1:jpoce,4) ) |
---|
175 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,5), iarroce(1:jpoce), zflx(1:jpoce,5) ) |
---|
176 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,6), iarroce(1:jpoce), zflx(1:jpoce,6) ) |
---|
177 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,7), iarroce(1:jpoce), zflx(1:jpoce,8) ) |
---|
178 | |
---|
179 | |
---|
180 | ! 3. Define NETCDF files and fields at beginning of first time step |
---|
181 | ! ----------------------------------------------------------------- |
---|
182 | |
---|
183 | IF( kt == nitsed000 ) THEN |
---|
184 | |
---|
185 | ! Define the NETCDF files |
---|
186 | CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian ) |
---|
187 | zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment |
---|
188 | CALL dia_nam ( clhstnam, nwrised, 'sed_T' ) |
---|
189 | CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, & |
---|
190 | & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & |
---|
191 | & nitsed000-1, zjulian, zdt, nhorised, nised , domain_id=nidom, snc4chunks=snc4set ) |
---|
192 | CALL histvert( nised,'deptht','Vertic.sed.T levels','m',ipk, profsed, ndepsed, 'down' ) |
---|
193 | CALL wheneq ( jpi*jpj*ipk, tmasksed, 1, 1., ndext52, ndimt52 ) |
---|
194 | CALL wheneq ( jpi*jpj, tmasksed(:,:,1), 1, 1., ndext51, ndimt51 ) |
---|
195 | |
---|
196 | ! Declare all the output fields as NETCDF variables |
---|
197 | |
---|
198 | DO jn = 1, jptrased |
---|
199 | cltra = sedtrcd(jn) ! short title for sediment variable |
---|
200 | cltral = sedtrcl(jn) ! long title for sediment variable |
---|
201 | cltrau = sedtrcu(jn) ! unit for sediment variable |
---|
202 | |
---|
203 | CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, & |
---|
204 | & ipk, 1, ipk, ndepsed, 32, clop, zsto, zout ) |
---|
205 | ENDDO |
---|
206 | |
---|
207 | ! 3D diagnostic |
---|
208 | DO jn = 1, jpdia3dsed |
---|
209 | cltra = seddia3d(jn) ! short title for 3D diagnostic |
---|
210 | cltral = seddia3l(jn) ! long title for 3D diagnostic |
---|
211 | cltrau = seddia3u(jn) ! UNIT for 3D diagnostic |
---|
212 | |
---|
213 | CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, & |
---|
214 | & ipk, 1, ipk, ndepsed, 32, clop, zsto, zout ) |
---|
215 | ENDDO |
---|
216 | |
---|
217 | ! Fluxes |
---|
218 | DO jn = 1, jpdia2dsed |
---|
219 | cltra = seddia2d(jn) ! short title for 2D diagnostic |
---|
220 | cltral = seddia2l(jn) ! long title for 2D diagnostic |
---|
221 | cltrau = seddia2u(jn) ! UNIT for 2D diagnostic |
---|
222 | |
---|
223 | CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, & |
---|
224 | & 1, 1, 1, -99, 32, clop, zsto, zout ) |
---|
225 | ENDDO |
---|
226 | |
---|
227 | |
---|
228 | CALL histend( nised, snc4set ) |
---|
229 | |
---|
230 | WRITE(numsed,*) |
---|
231 | WRITE(numsed,*) 'End of NetCDF sediment output file Initialization' |
---|
232 | |
---|
233 | ENDIF |
---|
234 | |
---|
235 | ! Start writing data |
---|
236 | ! --------------------- |
---|
237 | DO jn = 1, jptrased |
---|
238 | cltra = sedtrcd(jn) ! short title for 3D diagnostic |
---|
239 | CALL histwrite( nised, cltra, it, trcsedi(:,:,:,jn), ndimt52, ndext52 ) |
---|
240 | END DO |
---|
241 | |
---|
242 | DO jn = 1, jpdia3dsed |
---|
243 | cltra = seddia3d(jn) ! short title for 3D diagnostic |
---|
244 | CALL histwrite( nised, cltra, it, flxsedi3d(:,:,:,jn), ndimt52, ndext52 ) |
---|
245 | END DO |
---|
246 | |
---|
247 | DO jn = 1, jpdia2dsed |
---|
248 | cltra = seddia2d(jn) ! short title for 2D diagnostic |
---|
249 | CALL histwrite( nised, cltra, it, flxsedi2d(:,:,jn ), ndimt51, ndext51 ) |
---|
250 | END DO |
---|
251 | |
---|
252 | |
---|
253 | ! 3. Closing all files |
---|
254 | ! -------------------- |
---|
255 | IF( kt == nitsedend ) THEN |
---|
256 | CALL histclo( nised ) |
---|
257 | ENDIF |
---|
258 | |
---|
259 | DEALLOCATE( zdta ) ; DEALLOCATE( zflx ) |
---|
260 | |
---|
261 | END SUBROUTINE sed_wri |
---|
262 | |
---|
263 | #else |
---|
264 | !!====================================================================== |
---|
265 | !! MODULE sedwri : Dummy module |
---|
266 | !!====================================================================== |
---|
267 | !! $Id$ |
---|
268 | CONTAINS |
---|
269 | SUBROUTINE sed_wri( kt ) ! Empty routine |
---|
270 | INTEGER, INTENT(in) :: kt |
---|
271 | WRITE(*,*) 'sed_adv: You should not have seen this print! error?', kt |
---|
272 | END SUBROUTINE sed_wri |
---|
273 | |
---|
274 | !!====================================================================== |
---|
275 | #endif |
---|
276 | |
---|
277 | END MODULE sedwri |
---|