1 | MODULE sedwri |
---|
2 | !!====================================================================== |
---|
3 | !! *** MODULE sedwri *** |
---|
4 | !! Sediment diagnostics : write sediment output files |
---|
5 | !!====================================================================== |
---|
6 | USE sed |
---|
7 | USE sedarr |
---|
8 | USE lib_mpp ! distribued memory computing library |
---|
9 | USE iom |
---|
10 | USE lbclnk ! ocean lateral boundary conditions (or mpp link) |
---|
11 | |
---|
12 | IMPLICIT NONE |
---|
13 | PRIVATE |
---|
14 | |
---|
15 | !! * Accessibility |
---|
16 | PUBLIC sed_wri |
---|
17 | |
---|
18 | !! $Id$ |
---|
19 | CONTAINS |
---|
20 | |
---|
21 | !!---------------------------------------------------------------------- |
---|
22 | !! NetCDF output file |
---|
23 | !!---------------------------------------------------------------------- |
---|
24 | SUBROUTINE sed_wri( kt ) |
---|
25 | !!---------------------------------------------------------------------- |
---|
26 | !! *** ROUTINE sed_wri *** |
---|
27 | !! |
---|
28 | !! ** Purpose : output of sediment passive tracer |
---|
29 | !! |
---|
30 | !! History : |
---|
31 | !! ! 06-07 (C. Ethe) original |
---|
32 | !!---------------------------------------------------------------------- |
---|
33 | |
---|
34 | INTEGER, INTENT(in) :: kt |
---|
35 | |
---|
36 | INTEGER :: ji, jj, jk, js, jw, jn |
---|
37 | INTEGER :: it |
---|
38 | CHARACTER(len = 20) :: cltra |
---|
39 | REAL(wp) :: zrate |
---|
40 | REAL(wp), DIMENSION(jpoce, jpksed) :: zdta |
---|
41 | REAL(wp), DIMENSION(jpoce, jptrased+1) :: zflx |
---|
42 | REAL(wp), DIMENSION(jpi, jpj, jpksed, jptrased) :: trcsedi |
---|
43 | REAL(wp), DIMENSION(jpi, jpj, jpksed, jpdia3dsed) :: flxsedi3d |
---|
44 | REAL(wp), DIMENSION(jpi, jpj, jpdia2dsed) :: flxsedi2d |
---|
45 | |
---|
46 | !!------------------------------------------------------------------- |
---|
47 | |
---|
48 | |
---|
49 | ! Initialisation |
---|
50 | ! ----------------- |
---|
51 | |
---|
52 | ! 1. Initilisations |
---|
53 | ! ----------------------------------------------------------------- |
---|
54 | IF( ln_timing ) CALL timing_start('sed_wri') |
---|
55 | ! |
---|
56 | IF (lwp) WRITE(numsed,*) ' ' |
---|
57 | IF (lwp) WRITE(numsed,*) 'sed_wri kt = ', kt |
---|
58 | IF (lwp) WRITE(numsed,*) ' ' |
---|
59 | |
---|
60 | ! Initialize variables |
---|
61 | ! -------------------- |
---|
62 | |
---|
63 | trcsedi(:,:,:,:) = 0.0 |
---|
64 | flxsedi3d(:,:,:,:) = 0.0 |
---|
65 | flxsedi2d(:,:,:) = 0.0 |
---|
66 | |
---|
67 | ! 2. Back to 2D geometry |
---|
68 | ! ----------------------------------------------------------------- |
---|
69 | DO jn = 1, jpsol |
---|
70 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jn) , iarroce(1:jpoce), & |
---|
71 | & solcp(1:jpoce,1:jpksed,jn ) ) |
---|
72 | END DO |
---|
73 | |
---|
74 | DO jn = 1, jpwat |
---|
75 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jpsol + jn) , iarroce(1:jpoce), & |
---|
76 | & pwcp(1:jpoce,1:jpksed,jn ) ) |
---|
77 | END DO |
---|
78 | |
---|
79 | ! porosity |
---|
80 | zdta(:,:) = 0. |
---|
81 | DO jk = 1, jpksed |
---|
82 | DO ji = 1, jpoce |
---|
83 | zdta(ji,jk) = -LOG10( hipor(ji,jk) / ( densSW(ji) + rtrn ) + rtrn ) |
---|
84 | ENDDO |
---|
85 | ENDDO |
---|
86 | |
---|
87 | CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & |
---|
88 | & zdta(1:jpoce,1:jpksed) ) |
---|
89 | |
---|
90 | CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & |
---|
91 | & co3por(1:jpoce,1:jpksed) ) |
---|
92 | |
---|
93 | CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), & |
---|
94 | & saturco3(1:jpoce,1:jpksed) ) |
---|
95 | |
---|
96 | |
---|
97 | ! flxsedi3d = 0. |
---|
98 | zflx(:,:) = 0. |
---|
99 | ! Calculation of fluxes mol/cm2/s |
---|
100 | DO jw = 1, jpwat |
---|
101 | DO ji = 1, jpoce |
---|
102 | zflx(ji,jw) = ( pwcp(ji,1,jw) - pwcp_dta(ji,jw) ) & |
---|
103 | & * 1.e3 * ( 1.e-2 * dzkbot(ji) ) / 1.E4 / rDt_trc |
---|
104 | ENDDO |
---|
105 | ENDDO |
---|
106 | |
---|
107 | ! Calculation of fluxes g/cm2/s |
---|
108 | DO js = 1, jpsol |
---|
109 | zrate = 1.0 / rDt_trc |
---|
110 | DO ji = 1, jpoce |
---|
111 | zflx(ji,jpwat+js) = zflx(ji,jpwat+js) + ( tosed(ji,js) - fromsed(ji,js) ) * zrate |
---|
112 | ENDDO |
---|
113 | ENDDO |
---|
114 | |
---|
115 | ! Calculation of accumulation rate per dt |
---|
116 | DO js = 1, jpsol |
---|
117 | zrate = 1.0 / rDt_trc |
---|
118 | DO ji = 1, jpoce |
---|
119 | zflx(ji,jptrased+1) = zflx(ji,jptrased+1) + ( tosed(ji,js) - fromsed(ji,js) ) * zrate |
---|
120 | ENDDO |
---|
121 | ENDDO |
---|
122 | |
---|
123 | DO jn = 1, jpdia2dsed - 1 |
---|
124 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,jn), iarroce(1:jpoce), zflx(1:jpoce,jn) ) |
---|
125 | END DO |
---|
126 | |
---|
127 | zflx(:,1) = dzdep(:) / dtsed |
---|
128 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,jpdia2dsed), iarroce(1:jpoce), zflx(1:jpoce,1) ) |
---|
129 | |
---|
130 | ! |
---|
131 | CALL lbc_lnk( 'sedwri', trcsedi(:,:,:,:), 'T', 1._wp ) |
---|
132 | CALL lbc_lnk( 'sedwri', flxsedi3d(:,:,:,:), 'T', 1._wp ) |
---|
133 | CALL lbc_lnk( 'sedwri', flxsedi2d(:,:,:), 'T', 1._wp ) |
---|
134 | |
---|
135 | ! Start writing data |
---|
136 | ! --------------------- |
---|
137 | DO jn = 1, jptrased |
---|
138 | cltra = sedtrcd(jn) ! short title for 3D diagnostic |
---|
139 | CALL iom_put( cltra, trcsedi(:,:,:,jn) ) |
---|
140 | END DO |
---|
141 | |
---|
142 | DO jn = 1, jpdia3dsed |
---|
143 | cltra = seddia3d(jn) ! short title for 3D diagnostic |
---|
144 | CALL iom_put( cltra, flxsedi3d(:,:,:,jn) ) |
---|
145 | END DO |
---|
146 | |
---|
147 | DO jn = 1, jpdia2dsed |
---|
148 | cltra = seddia2d(jn) ! short title for 2D diagnostic |
---|
149 | CALL iom_put( cltra, flxsedi2d(:,:,jn) ) |
---|
150 | END DO |
---|
151 | |
---|
152 | IF( ln_timing ) CALL timing_stop('sed_wri') |
---|
153 | |
---|
154 | END SUBROUTINE sed_wri |
---|
155 | |
---|
156 | END MODULE sedwri |
---|