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 branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/TOP_SRC/PISCES/SED – NEMO

source: branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedwri.F90 @ 4291

Last change on this file since 4291 was 3443, checked in by cetlod, 12 years ago

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