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.
sedwri.F90 in trunk/NEMO/TOP_SRC/SED – NEMO

source: trunk/NEMO/TOP_SRC/SED/sedwri.F90 @ 1329

Last change on this file since 1329 was 1329, checked in by cetlod, 15 years ago

update modules to take into account the mask land points in NetCDF outputs, see ticket:322

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