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 @ 1317

Last change on this file since 1317 was 1317, checked in by smasson, 15 years ago

nwrite = modulo referenced to nit000 in all ouputs, see ticket:339

File size: 10.4 KB
RevLine 
[1179]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
[1312]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
[1179]63#if defined key_diainstant
64      zsto = nwrised * zdt
[1312]65      clop = "inst("//TRIM(clop)//")"
[1179]66#else
67      zsto = zdt
[1312]68      clop = "ave("//TRIM(clop)//")"
[1179]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
[1250]132      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1)  , iarroce(1:jpoce), &
[1179]133         &                   zdta(1:jpoce,1:jpksed)  )
134     
[1250]135      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2)  , iarroce(1:jpoce), &
[1179]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
[1250]147      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,3)  , iarroce(1:jpoce), &
[1179]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
[1250]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)  )
[1179]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       
[1310]182         CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian )
183         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
[1179]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
[1250]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
[1179]198
199            CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, &
200               &          ipk, 1, ipk, ndepsed, 32, clop, zsto, zout )
201         ENDDO
202
[1250]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
[1179]213         !Fluxes
[1250]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
[1179]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      ELSE
230
231
232         ! Start writing data
233         ! ---------------------
234          DO jn = 1, jptrased
[1250]235             cltra = sedtrcd(jn) ! short title for 3D diagnostic
[1179]236             CALL histwrite( nised, cltra, it, trcsedi(:,:,:,jn), ndimt52, ndext52 )
237          END DO
238
[1250]239          DO jn = 1, jpdia3dsed
240             cltra = seddia3d(jn) ! short title for 3D diagnostic
241             CALL histwrite( nised, cltra, it, flxsedi3d(:,:,:,jn), ndimt52, ndext52 )
[1179]242          END DO
243
[1250]244          DO jn = 1, jpdia2dsed
245             cltra = seddia2d(jn) ! short title for 2D diagnostic
246             CALL histwrite( nised, cltra, it, flxsedi2d(:,:,jn  ), ndimt51, ndext51 )
247          END DO
[1179]248
[1250]249
[1179]250         !!
251         !! synchronise FILE
252         !
[1317]253         IF( MOD( it, nwrised ) == 0 ) THEN
[1179]254              WRITE(numsed,*)  '**** sedwri : write NetCDF aditional arrays'
255              CALL histsync( nised )
256          ENDIF
257
258      ENDIF
259
260! 3. Closing all files
261! --------------------
262      IF( kt == nitsedend  ) THEN
263          CALL histclo( nised )
264      ENDIF
265
266      DEALLOCATE( zdta )    ;   DEALLOCATE( zflx )
267
268   END SUBROUTINE sed_wri
269
270#else
271   !!======================================================================
[1250]272   !! MODULE sedwri  :   Dummy module
[1179]273   !!======================================================================
[1250]274CONTAINS
275   SUBROUTINE sed_wri( kt )         ! Empty routine
276      INTEGER, INTENT(in) :: kt
277      WRITE(*,*) 'sed_adv: You should not have seen this print! error?', kt
278   END SUBROUTINE sed_wri
[1179]279
[1250]280   !!======================================================================
[1179]281#endif
282
283END MODULE sedwri
Note: See TracBrowser for help on using the repository browser.