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 NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/PISCES/SED – NEMO

source: NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/PISCES/SED/sedwri.F90 @ 9939

Last change on this file since 9939 was 9939, checked in by gm, 6 years ago

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