1 | MODULE sedwri |
---|
2 | !!====================================================================== |
---|
3 | !! *** MODULE sedwri *** |
---|
4 | !! Sediment diagnostics : write sediment output files |
---|
5 | !!====================================================================== |
---|
6 | USE par_sed |
---|
7 | USE sed |
---|
8 | USE sedarr |
---|
9 | USE lib_mpp ! distribued memory computing library |
---|
10 | USE iom |
---|
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), ALLOCATABLE, DIMENSION(:,:) :: zdta, zflx |
---|
41 | |
---|
42 | !!------------------------------------------------------------------- |
---|
43 | |
---|
44 | |
---|
45 | ! Initialisation |
---|
46 | ! ----------------- |
---|
47 | |
---|
48 | ! 1. Initilisations |
---|
49 | ! ----------------------------------------------------------------- |
---|
50 | IF( ln_timing ) CALL timing_start('sed_wri') |
---|
51 | ! |
---|
52 | IF (lwp) WRITE(numsed,*) ' ' |
---|
53 | IF (lwp) WRITE(numsed,*) 'sed_wri kt = ', kt |
---|
54 | IF (lwp) WRITE(numsed,*) ' ' |
---|
55 | |
---|
56 | ALLOCATE( zdta(jpoce,jpksed) ) ; ALLOCATE( zflx(jpoce,jpwatp1) ) |
---|
57 | |
---|
58 | ! Initialize variables |
---|
59 | ! -------------------- |
---|
60 | |
---|
61 | trcsedi(:,:,:,:) = 0.0 |
---|
62 | flxsedi3d(:,:,:,:) = 0.0 |
---|
63 | flxsedi2d(:,:,:) = 0.0 |
---|
64 | |
---|
65 | ! 2. Back to 2D geometry |
---|
66 | ! ----------------------------------------------------------------- |
---|
67 | DO jn = 1, jpsol |
---|
68 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jn) , iarroce(1:jpoce), & |
---|
69 | & solcp(1:jpoce,1:jpksed,jn ) ) |
---|
70 | END DO |
---|
71 | |
---|
72 | DO jn = 1, jpwat |
---|
73 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jpsol + jn) , iarroce(1:jpoce), & |
---|
74 | & pwcp(1:jpoce,1:jpksed,jn ) ) |
---|
75 | END DO |
---|
76 | |
---|
77 | ! porosity |
---|
78 | zdta(:,:) = 0. |
---|
79 | DO jk = 1, jpksed |
---|
80 | DO ji = 1, jpoce |
---|
81 | zdta(ji,jk) = -LOG10( hipor(ji,jk) / ( densSW(ji) + rtrn ) + rtrn ) |
---|
82 | ENDDO |
---|
83 | ENDDO |
---|
84 | |
---|
85 | CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & |
---|
86 | & zdta(1:jpoce,1:jpksed) ) |
---|
87 | |
---|
88 | CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & |
---|
89 | & co3por(1:jpoce,1:jpksed) ) |
---|
90 | |
---|
91 | ! flxsedi3d = 0. |
---|
92 | zflx(:,:) = 0. |
---|
93 | ! Calculation of fluxes mol/cm2/s |
---|
94 | DO jw = 1, jpwat |
---|
95 | DO ji = 1, jpoce |
---|
96 | zflx(ji,jw) = ( pwcp(ji,1,jw) - pwcp_dta(ji,jw) ) & |
---|
97 | & * 1.e3 / 1.e2 * dzkbot(ji) / rDt_trc |
---|
98 | ENDDO |
---|
99 | ENDDO |
---|
100 | |
---|
101 | ! Calculation of accumulation rate per dt |
---|
102 | DO js = 1, jpsol |
---|
103 | zrate = 1.0 / ( denssol * por1(jpksed) ) / rDt_trc |
---|
104 | DO ji = 1, jpoce |
---|
105 | zflx(ji,jpwatp1) = zflx(ji,jpwatp1) + ( tosed(ji,js) - fromsed(ji,js) ) * zrate |
---|
106 | ENDDO |
---|
107 | ENDDO |
---|
108 | |
---|
109 | DO jn = 1, jpdia2dsed - 1 |
---|
110 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,jn), iarroce(1:jpoce), zflx(1:jpoce,jn) ) |
---|
111 | END DO |
---|
112 | zflx(:,1) = dzdep(:) / dtsed |
---|
113 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,jpdia2dsed), iarroce(1:jpoce), zflx(1:jpoce,1) ) |
---|
114 | |
---|
115 | ! Start writing data |
---|
116 | ! --------------------- |
---|
117 | DO jn = 1, jptrased |
---|
118 | cltra = sedtrcd(jn) ! short title for 3D diagnostic |
---|
119 | CALL iom_put( cltra, trcsedi(:,:,:,jn) ) |
---|
120 | END DO |
---|
121 | |
---|
122 | DO jn = 1, jpdia3dsed |
---|
123 | cltra = seddia3d(jn) ! short title for 3D diagnostic |
---|
124 | CALL iom_put( cltra, flxsedi3d(:,:,:,jn) ) |
---|
125 | END DO |
---|
126 | |
---|
127 | DO jn = 1, jpdia2dsed |
---|
128 | cltra = seddia2d(jn) ! short title for 2D diagnostic |
---|
129 | CALL iom_put( cltra, flxsedi2d(:,:,jn) ) |
---|
130 | END DO |
---|
131 | |
---|
132 | |
---|
133 | DEALLOCATE( zdta ) ; DEALLOCATE( zflx ) |
---|
134 | |
---|
135 | IF( ln_timing ) CALL timing_stop('sed_wri') |
---|
136 | |
---|
137 | END SUBROUTINE sed_wri |
---|
138 | |
---|
139 | END MODULE sedwri |
---|